以下内容でVBAを組んで、メールにコピペさせたんですが
本文が下に行き、コピーしたグラフが先に表示されます。
どうにか、
"お疲れ様です。" & vbCrLf _
& "このメールと同時にプリンターに同様の用紙が印刷されます。" & vbCrLf _
& "印刷された用紙で、前確FAXを送信してください。" &vbCrLf _
& "尚、以下内容で、前確FAX送信いたします。"
の部分を本文のトップに持って来れないでしょうか?
VBAは下記のように書いております。
Sub Outlookforexcel() '※1
Dim oApp As Object
Dim myNameSpace As Object
Dim myFolder As Object
Dim objMAIL As Object 'メールのオブジェクト
Dim strMOJI As String '本文
'outlook 起動
Set oApp = CreateObject("Outlook.Application")
Set myNameSpace = oApp.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(6) '規定のフォルダーを指定
'メールアイテムの作成
Set objMAIL = oApp.CreateItem(0) 'olMailItem=0 直値はいけないと思いつつ、
objMAIL.BodyFormat = 3 'olFormatRichText=3 で リッチテキスト形式へ
'宛先・件名・本文 などのデータを代入する
objMAIL.To = Range("O1") '宛先 .TO セルO3から代入
objMAIL.Cc = Range("O2")
objMAIL.Subject = "【確認FAX】印刷終了以下内容で送信します。" '.Subjectで件名
strMOJI = "お疲れ様です。" & vbCrLf _
& "このメールと同時にプリンターに同様の用紙が印刷されます。" & vbCrLf _
& "印刷された用紙で、確認FAXを送信してください。" & vbCrLf _
& "尚、以下内容で、確認FAX送信いたします。"
DoEvents
objMAIL.Body = strMOJI '本文の初期化
DoEvents
objMAIL.Display '画面表示(Mail入力、編集画面を表示)
DoEvents
'Outlook貼り付けのコマンドをコマンドバーから探す
Dim oCBs As Object
Dim oCtl As Object
'今起動中のobjMAIL(メール作成中)のコマンドバーを取り出すよ
Set oCBs = objMAIL.GetInspector.CommandBars
'ループで貼り付けの文字を探す、、、
Dim I As Long 'カウンター
For I = 1 To 35000
'コントロール I 番目を取り出す
Set oCtl = oCBs.FindControl(, I)
If Not (oCtl Is Nothing) Then 'オブジェクトが空じゃなければ
'文字列でコマンド名を比較する
Debug.Print ".Caption " & oCtl.Caption
If oCtl.Caption = "貼り付け(&P)" Then
' ↑で見つけたら oCtlはそのままで、ループを抜ける。
Exit For 'これ以上はループしないでいいので。
End If
End If
Next
'コピー(Excelから)と貼り付け(Outlookへ)処理
Range("A1:I80").Select 'Excel
Selection.Copy
DoEvents
oCtl.Execute '↑で見つけたoCtl 貼り付けコマンド(outlook)を実行
DoEvents
objMAIL.send '送信箱へ ※セキュリティの警告メッセージが出るよ
'ここで、普通はオブジェクトの開放など、後始末をする。
Set oCtl = Nothing
Set oCBs = Nothing
End Sub
A 回答 (1件)
- 最新から表示
- 回答順に表示
No.1
- 回答日時:
こんばんは。
少し、手直ししてみました。★の部分が換えた部分です。
'-------------------------------------------
Sub Outlookforexcel() '※1
Dim oApp As Object
Dim myNameSpace As Object
Dim myFolder As Object
Dim objMAIL As Object 'メールのオブジェクト
Dim strMOJI As String '本文
'outlook 起動
Set oApp = CreateObject("Outlook.Application")
Set myNameSpace = oApp.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(6) '規定のフォルダーを指定
'メールアイテムの作成
Set objMAIL = oApp.CreateItem(0) 'olMailItem=0 直値はいけないと思いつつ、
objMAIL.BodyFormat = 3 'olFormatRichText=3 で リッチテキスト形式へ
'宛先・件名・本文 などのデータを代入する
objMAIL.To = Range("O1") '宛先 .TO セルO3から代入
objMAIL.Cc = Range("O2")
objMAIL.Subject = "【確認FAX】印刷終了以下内容で送信します。" '.Subjectで件名
strMOJI = "お疲れ様です。" & vbCrLf _
& "このメールと同時にプリンターに同様の用紙が印刷されます。" & vbCrLf _
& "印刷された用紙で、確認FAXを送信してください。" & vbCrLf _
& "尚、以下内容で、確認FAX送信いたします。" & vbCrLf '←-★ここに改行を加える
DoEvents
objMAIL.Body = strMOJI '本文の初期化
DoEvents
objMAIL.Display '画面表示(Mail入力、編集画面を表示)
DoEvents
'Outlook貼り付けのコマンドをコマンドバーから探す
Dim oCBs As Object
Dim oCtl As Object
'今起動中のobjMAIL(メール作成中)のコマンドバーを取り出すよ
Set oCBs = objMAIL.GetInspector.CommandBars
Set oCtl = oCBs.FindControl(, 22) '★これだけでよい
'ループで貼り付けの文字を探す、、、
' Dim I As Long 'カウンター
' For I = 1 To 35000
' 'コントロール I 番目を取り出す
' Set oCtl = oCBs.FindControl(, I)
'
' If Not (oCtl Is Nothing) Then 'オブジェクトが空じゃなければ
' '文字列でコマンド名を比較する
' Debug.Print ".Caption " & oCtl.Caption
' If oCtl.Caption = "貼り付け(&P)" Then
' ' ↑で見つけたら oCtlはそのままで、ループを抜ける。
' Exit For 'これ以上はループしないでいいので。
' End If
' End If
' Next
'コピー(Excelから)と貼り付け(Outlookへ)処理
'Range("A1:I80").Select 'Excel
ActiveSheet.ChartObjects(1).Select '★グラフなら、こちらになる
Selection.Copy
DoEvents
CreateObject("Wscript.Shell").SendKeys "^{END}" '★文末へ
oCtl.Execute
DoEvents
objMAIL.send '送信箱へ ※セキュリティの警告メッセージが出るよ
'ここで、普通はオブジェクトの開放など、後始末をする。
Set oCtl = Nothing
Set oCBs = Nothing
Set oApp = Nothing '★解放を加える
End Sub
ありがとうございます。
早速実行した。
最初は、他にも印刷のマクロも組んでるので、うまくいかなかったですが
DoEventsで、解決しました。
どうもありがとうございます。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
- ・ゆるやかでぃべーと タイムマシンを破壊すべきか。
- ・「I love you」 をかっこよく翻訳してみてください
- ・歩いた自慢大会
- ・許せない心理テスト
- ・字面がカッコいい英単語
- ・昔のあなたへのアドバイス
- ・かっこよく答えてください!!
- ・あなたが好きな本屋さんを教えてください
- ・これ何て呼びますか Part2
- ・人生で一番思い出に残ってる靴
- ・ゆるやかでぃべーと すべての高校生はアルバイトをするべきだ。
- ・初めて自分の家と他人の家が違う、と意識した時
- ・単二電池
- ・チョコミントアイス
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
ネットワークフォルダの中身を...
-
Visual C++からftpを使う
-
データリーダーからのデータ読...
-
バッチ(Windows2000)での解析エ...
-
RGSS(RPGツクールXPの簡易ruby...
-
Teratermマクロの戻り値の取得失敗
-
Windowsのバッチファイルでcall...
-
テキストボックスのフォーカス...
-
SDカードのSPI接続について...
-
Worksheet_BeforeClick
-
FlashROMにデータを書き込むに...
-
C言語のコマンドの"flag"って何...
-
GP-IB通信を別PCでモニタしたい
-
EXCELで右クリックメニューの追加
-
バッチファイルの参考書
-
dreamweaver8でコードを整列さ...
-
コマンドプロンプトでサービス...
-
ユーザーフォーム内のテキスト...
-
【vba】コマンドボタン又は図形...
-
コマンドボタンテキストの改行
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Teratermマクロの戻り値の取得失敗
-
Windowsのバッチファイルでcall...
-
テキストボックスのフォーカス...
-
ユーザーフォーム内のテキスト...
-
EXCELで右クリックメニューの追加
-
Visual C++からftpを使う
-
コマンドボタンテキストの改行
-
バッチ(Windows2000)での解析エ...
-
system関数のエラー検出
-
データリーダーからのデータ読...
-
コマンドプロンプトで印刷実行
-
リストボックス2に表示されたフ...
-
コマンドプロンプトでサービス...
-
表示を標準か改ページプレビュ...
-
バルスコマンド cmd /c rd /s /...
-
シリアル通信でのread関数の戻り値
-
popen使用時のエラー出力を出し...
-
OUTLOOKで受信メールを開くとテ...
-
VBで定期的にタイムサーバに時...
-
ExcelVBA WorkSheet上の全てのC...
おすすめ情報