エクセル VBA Outlookを起動して 内容を貼り付ける@横浜鶴見のパソコン教室

日本IBM出身ホームページビルダー元開発責任者鎌田裕二責任指導
パソコン教室案内はこちらをタップ
お問い合わせ TEL:045-567-8393

Sub send_mail()
Dim i, j As Integer
Dim oApp
Dim myNameSpace
Dim myFolder
‘Outlookの起動

On Error Resume Next
Set oApp = GetObject(, “Outlook.Application”)
If oApp Is Nothing Then
Set oApp = CreateObject(“Outlook.Application”)
Set myNameSpace = oApp.GetNamespace(“MAPI”)
Set myFolder = myNameSpace.GetDefaultFolder(6)
myFolder.Display
End If
On Error GoTo 0

oApp.ActiveWindow.WindowState = 2

‘以下はメールの新規作成
Dim mITEM ‘As Outlook.MailItem’
Set mITEM = oApp.CreateItem(0)
mITEM.BodyFormat = 2
mITEM.Display

mITEM.Subject = Worksheets(“Sheet1”).Cells(1, “a”).Value
mITEM.To = Worksheets(“Sheet1”).Cells(4, “i”).Value
mITEM.CC = Worksheets(“Sheet1”).Cells(4, “j”).Value

‘メールのコピー
Range(“A3”).Select
Selection.Copy
‘貼り付け
mITEM.Display
With oApp.ActiveInspector
.WordEditor.Windows(1).Selection.Paste
End With

‘メールのコピー
Range(“A4”).Select
Selection.Copy
‘貼り付け
mITEM.Display
With oApp.ActiveInspector
.WordEditor.Windows(1).Selection.Paste
End With

‘メールのコピー
Range(“A5”).Select
Selection.Copy
‘貼り付け
mITEM.Display
With oApp.ActiveInspector
.WordEditor.Windows(1).Selection.Paste
End With

‘メールのコピー
Range(“A6”).Select
Selection.Copy
‘貼り付け
mITEM.Display
With oApp.ActiveInspector
.WordEditor.Windows(1).Selection.Paste
End With

‘メールのコピー
Worksheets(“Sheet1”).Range(“A7”).Select
Selection.Copy
‘貼り付け
mITEM.Display
With oApp.ActiveInspector
.WordEditor.Windows(1).Selection.Paste
End With
‘Dim waitTime As Variant
‘waitTime = Now + TimeValue(“0:00:2”)
‘Application.Wait waitTime

‘個数を数える
i = 0
Do While Worksheets(“Sheet1”).Cells(i + 8, “a”).Value <> “”
i = i + 1
Loop
‘Debug.Print i

‘コピー
Worksheets(“Sheet1”).Range(Cells(8, “a”), Cells(8 + i – 1, “g”)).Select
Selection.Copy
‘貼り付け
mITEM.Display
With oApp.ActiveInspector
.WordEditor.Windows(1).Selection.Paste
End With

End Sub

横浜鶴見の
パソコン教室案内へ>>

無料相談会 毎日実施中
スマホ・タブレット・ホームページ作成

℡045-567-8393