-1
我試圖通過電子郵件發送到表格中的所有電子郵件地址，主題行是相應的訂單號碼或數字。通過Excel表格發送電子郵件
表中有五列 - 「行號」，「訂單號」，「Suppler/Manf.Item號」，「供應商名稱」和「電子郵件地址」
有可能是重複的，但主題每個PO只能包含一次。
沒有CC，BCC或需要
的電子郵件的正文是列出PO與他們相關聯的項目。
您好，我們需要更新爲以下幾點：
EX
PO86001763
行項目2
行項目1請發送更新爲這些線路的狀態項目。 提供以下內容：裝箱單，追蹤號碼和更新的發貨日期。
（這些能夠被編輯將是一個福音）
該表是從進口和格式宏觀製成，它總是會在相同的格式，但會包含不同的數據。數據量可以增加或減少，具體取決於一週。
這裏是我的嘗試。
Private Sub CommandButton2_Click()
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
Dim I As Integer
Dim X As Integer
Dim C As Object
Dim firstaddress As Variant
Dim Nrow As Boolean
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 = "Order(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("Order Number").Index)
lineCounter = lineCounter + 1
bodyline = "Order " & tb.DataBodyRange.Cells(Nrow, tb.ListColumns("Order Number").Index) & ", Line Number " & tb.DataBodyRange.Cells(Nrow, tb.ListColumns("Line Number").Index)
Else:
subjectLine = subjectLine & ", " & tb.DataBodyRange.Cells(Nrow, tb.ListColumns("Order Number").Index)
bodyline = bodyline & vbNewLine & "Order " & tb.DataBodyRange.Cells(Nrow, tb.ListColumns("Order Number").Index) & ", Line Number " & tb.DataBodyRange.Cells(Nrow, tb.ListColumns("Line 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 I As Integer
NL = vbNewLine
DNL = vbNewLine & vbNewLine
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
Set tb = ActiveSheet.ListObjects("Table10")
For I = 1 To ActiveSheet.ListObjects("Table10").ListRows.Count
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = emAddress
.Subject = subjectLine
.Body = "Hello, We require an update as to the following:" & DNL & bodyline _
& DNL & _
"Please Send an update as to the status of these line items " & _
"providing the following: Packing Slips, Tracking Numbers and Updated Ship Dates."
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Next I
End Function
歡迎來到SO。 * IT不起作用*並不能真正幫助我們提供幫助。什麼不行？你期望發生什麼事情沒有發生？請讓我們更容易幫助你。你也可能喜歡直接循環訪問'ListObject'，就像在[這裏]一樣（http://stackoverflow.com/questions/12495678/how-do-i-loop-an-excel-2010-table-by-using -his-name-column-reference＃12497229） –
註釋掉'On Error Resume Next' - 你有錯誤嗎？ –
對不起，斯科特。一行一行我得到一個表的參考錯誤。我相信我錯了。但我不確定如何正確定義它。 –