2
メーカーの名前の新しい書籍にメーカー名でデータをエクスポートするコードを書いています。自動メールに関連性の高いファイルを添付する
私はメーカーに電子メールを自動的に送信する電子メールマクロを調整しました。私はそれが自動的にマイドキュメント
から私のファイルを添付したい
は、ここで私が持っているものだが、それは何を添付しません。
Sub BacklogEmail()
Dim subjectLine As String
Dim bodyline As String
Dim tb As ListObject
Dim lineCounter As Long
Dim myArray1, arrayCounter As Long, tempNumb As Long
Dim nameCounter As Long
Dim emAddress As String
ReDim myArray1(1 To 1)
arrayCounter = 0
nameCounter = 1
Set tb = ActiveSheet.ListObjects("Table10")
For i = 1 To ActiveSheet.ListObjects("Table10").ListRows.Count
emAddress = tb.DataBodyRange.Cells(i, tb.ListColumns("Email Address").Index)
For X = LBound(myArray1) To UBound(myArray1)
On Error Resume Next
If emAddress = myArray1(X) Then GoTo goToNext
Next X
On Error GoTo 0
subjectLine = "Obsolescence Report for Manufacturer(s) "
ReDim Preserve myArray1(1 To nameCounter)
myArray1(nameCounter) = emAddress
nameCounter = nameCounter + 1
lineCounter = 1
With tb.ListColumns("Email Address").Range
Set C = .Find(emAddress, LookIn:=xlValues)
If Not C Is Nothing Then
firstaddress = C.Address
Beep
arrayCounter = arrayCounter + 1
Do
Nrow = C.Row - 1
If lineCounter = 1 Then
subjectLine = subjectLine & tb.DataBodyRange.Cells(Nrow, tb.ListColumns("Manufacturer Name").Index)
lineCounter = lineCounter + 1
' bodyline = "Manufacturer " & tb.DataBodyRange.Cells(Nrow, tb.ListColumns("Manufacturer Name").Index) & ", Manufacturer Item Number " & tb.DataBodyRange.Cells(Nrow, tb.ListColumns("Manufacturer Item Number").Index)
Else:
subjectLine = subjectLine
'bodyline = bodyline & vbNewLine & "Manufacturer " & tb.DataBodyRange.Cells(Nrow, tb.ListColumns("Manufacturer Name").Index) & ", Manufacturer Item Number " & tb.DataBodyRange.Cells(Nrow, tb.ListColumns("Manufacturer Item Number").Index)
End If
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> firstaddress
End If
Run SendMailFunction(emAddress, subjectLine, bodyline)
' Debug.Print vbNewLine
' Debug.Print emAddress
' Debug.Print "Subject: " & subjectLine
' Debug.Print "Body:" & vbNewLine; bodyline
End With
goToNext:
Next i
Set C = Nothing
End Sub
Function SendMailFunction(emAddress As String, subjectLine As String, bodyline As String)
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim tb As ListObject
Dim NL As String
Dim DNL As String
Dim lineCounter As Long
Dim myArray1, arrayCounter As Long, tempNumb As Long
Dim nameCounter As Long
ReDim myArray1(1 To 1)
arrayCounter = 0
nameCounter = 1
NL = vbNewLine
DNL = vbNewLine & vbNewLine
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
Set tb = ActiveSheet.ListObjects("Table10")
ReDim Preserve myArray1(1 To nameCounter)
myArray1(nameCounter) = emAddress
nameCounter = nameCounter + 1
lineCounter = 1
With tb.ListColumns("Email Address").Range
Set C = .Find(emAddress, LookIn:=xlValues)
If Not C Is Nothing Then
firstaddress = C.Address
Beep
arrayCounter = arrayCounter + 1
Nrow = C.Row - 1
If lineCounter = 1 Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = emAddress
.Subject = subjectLine
.Body = "Hello, attached is an excel file that we require you to complete. " & _
"This is required by as we must know when parts are going to become obsolete. " & _
"We appriciate your contribution to keeping our databases current. " & _
"Thank you for your timely response."
.Attachments.Add "U:\\\\" & tb.DataBodyRange.Cells(Nrow, tb.ListColumns("Manufacturer Name").Index) & ".xlsx"
lineCounter = lineCounter + 1
.Display
On Error GoTo 0
Set OutMail = Nothing
End With
End If
End If
End With
End Function
「フォーマット（Now（）、「********」）で何をやっていますか？それはまったく解決しない？ – CLR
あなたのプログラムは 'C：\ Users \ dmack \ my Documents \ Manufacturer Name.xlsx'というファイルを各メールに添付しようとしています。おそらくそれは存在しないので、それを添付することはできません。 – CLR
...「On Error Resume Next」を使用して無効にしたため、エラーが表示されません。 – CLR