|
VBAをかじったぐらいの者です。
Excel VBAにて下記を組んで、Auto_Openに記述して、自動メール送信をしています。
手動にて動作させる分には動作するのですが、タスクスケジューラにて動作させようとすると、動作しません。。
なにがいけないのか。。全然わからない状態です。。
すみませんが、ご教授をお願いいたします。
コード:
Dim Ap As Object
Dim M As Object
Dim strMOJI(2) As String
Dim Ldate As Date
Application.DisplayAlerts = False
ActiveWorkbook.UpdateLinks = xlUpdateLinksAlways
Ldate = Date - 1
Worksheets("Report(Nr)").Select
Range("E2").Value = Ldate
Range("A1:Y72").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
'ここまではメールに張り付けるデータを作成しており、動作するのを確認しております。
Set Ap = CreateObject("Outlook.Application")
Set M = Ap.CreateItem(0)
strMOJI(0) = "各位 お疲れ様です。 " & Range("E2").Value & " の状況を報告いたします。" & vbCrLf
strMOJI(1) = vbCrLf & " 以上です。" & vbCrLf
strMOJI(2) = strMOJI(0) & strMOJI(1)
strMOJI(2) = Replace(strMOJI(2), vbCrLf, "<br>")
M.BodyFormat = 3 'リッチテキスト形式
M.HTMLBody = "" & strMOJI(2) & "" 'メールの本文
M.To = Range("AB7").Value & ";" & Range("AC7").Value 'To アドレス
M.Cc = Range("AB8").Value & ";" & Range("AC8").Value 'Cc アドレス
M.Bcc = Range("AB9").Value & ";" & Range("AC9").Value 'Cc アドレス
M.Subject = Range("E2").Value & " 稼働報告" '件名
M.Display '画面を表示
n = Len(strMOJI(0))
With Ap.ActiveInspector.WordEditor.Windows(1).Selection
'貼り付け
.GoTo 3, 1, 2
.Paste
End With
M.Send
ActiveWorkbook.Save
Application.Quit
ThisWorkbook.Close False
|
|