อาจารย์และเพื่อนๆ ในบอร์ด พอดีหนูต้องการ เขียน loop การทำงานประมาณนี้ แต่ติดปัญหา ไม่ทราบว่า เราสามารถแก้ไขโค้ด
เนื่องจาก Column A มีข้อมูลที่เป็น Commodity ต่างกัน หนูเขียนโค้ดให้เช็คค่า ในแต่ละ Column
และใช้ loop for ในการวนค่า แล้วในรูป for มีการซ้อน if ซึ่งมีลักษณะดังรูป แต่ loop for ไม่สามารถ Next ได้หลายครั้ง
หนูจะเขียน Code ในล้กษณะนี้ได้อย่างไรคะ อันนี้คือ logic ตัวอย่างที่ไม่ใช่โค้ดจริง
Code: Select all
Private Sub CommandButton4_Click()
Dim noSession As Object, noDatabase As Object, noDocument As Object
Dim obAttachment As Object, EmbedObject As Object, stPath As Object
Dim stSubject As Variant, stSubcode As Variant, stSubname As Variant, stAttachment As String, stsupplier As String
Dim vaRecipient As Variant, subMsg, vaMsg, NameMsg, signMsg, posMsg, contMsg, strMsg As Variant
Dim MyObj As Object, MySource As Object, file As Variant
Dim stFile, stcode, stname As String
Dim FName As String
Const EMBED_ATTACHMENT As Long = 1454
Const stTitle As String = "Status Active workbook"
Const stMsg As String = "The active workbook must first be saved " & vbCrLf _
& "before it can be sent as an attachment."
Worksheets("tempsheet").Activate
'found file in folder --------------------------------------------------------------------------------------------
file = Dir("C:\Users\PUR_Kannaree\Desktop\File RFQ\p'kant\FILE\File Attachment\")
While (file <> "")
Dim i, LastRow As Long
Dim fnst As String
With Sheets("tempsheet")
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
End With
If LastRow > 0 Then
For i = 2 To LastRow
fnst = Range("A" & i).Value
FName = fnst
If InStr(file, FName) > 0 Then
stFile = file
file = Dir
End If
'vlookup send email--------------------------------------------------------------------------------------------------------------------
Dim rng As String
Dim ws1, ws2 As Worksheet
Dim MyStringVar1, Stcustomer, StApp, Stduedate As String
Dim r, LastRow1 As Long
Set ws1 = ThisWorkbook.Sheets("template")
Set ws2 = ThisWorkbook.Sheets("tempsheet")
With Sheets("tempsheet")
LastRow1 = Cells(Rows.Count, "A").End(xlUp).Row
End With
If LastRow1 > 0 Then
rng = Range("A" & i).Value
stFile = rng
MsgBox rng
'---- Commodity "30" ----------------------------------------------------------------------------------------------------'
Dim j As Integer
If rng = "30" Then
With ws2
On Error Resume Next 'add this because if value is not found, vlookup fails, you get 1004
Stcustomer = Application.WorksheetFunction.VLookup(rng, ws1.Range("B2:P3000").Value, 2, False)
MsgBox Stcustomer
StApp = Application.WorksheetFunction.VLookup(rng, ws1.Range("B2:P3000").Value, 3, False)
MsgBox StApp
Stduedate = Application.WorksheetFunction.VLookup(rng, ws1.Range("B2:P3000").Value, 4, False)
MsgBox Stduedate
On Error GoTo 0
End With
For j = 1 To 3
MsgBox j
If j = 1 Then
stcode = "1500196"
stname = "EXIM"
MyStringVar1 = "kannaree.wawa@gmail.com"
ElseIf j = 2 Then
stcode = "1500209"
stname = "BOSSARD"
MyStringVar1 = "kannaree.wawa@gmail.com"
ElseIf j = 3 Then
stcode = "1500062"
stname = "ITS"
MyStringVar1 = "kannaree.wawa@gmail.com"
End If
If MyStringVar1 = "" Then
MsgBox "Item not found"
End If
'--------------------------------------------------------------------------------------
'Check if the active workbook is saved or not
'If the active workbook has not been saved at all.
If Len(ActiveWorkbook.Path) = 0 Then
MsgBox stMsg, vbInformation, stTitle
Exit Sub
End If
'If the changes in the active workbook has been saved or not.
If ActiveWorkbook.Saved = False Then
If MsgBox("Do you want to save the changes before sending?", _
vbYesNo + vbInformation, stTitle) = vbYes Then _
ActiveWorkbook.Save
End If
'Get the name of the recipient from the user.
vaRecipient = MyStringVar1
'Array("Joe_Boe@somewhere.com", "kristen_Dean@somewhere.com", "john_doe@somewhereelse.com", "jane.doe@anotherplace.com")
'If the user has canceled the operation.
If vaRecipient = False Then Exit Sub
'Get the message from the user.
subMsg = "Dear Supplier," & vbNewLine
vaMsg = vbNewLine & " " & "Customer Name : " & Stcustomer & vbNewLine & " " & "Application : " & StApp & vbNewLine & " " & "Due date : " & Stduedate & vbNewLine & " " & vbNewLine & "*** Please open the file attachment for update then reply email ***" & vbNewLine
signMsg = vbNewLine & vbNewLine & vbNewLine & "Best regards,"
NameMsg = vbNewLine & vbNewLine & vbNewLine & " " & "> Apimuk Hattakit <"
posMsg = vbNewLine & "Sourcing Engineer (Plastic)"
contMsg = vbNewLine & "SVI PUBLIC COMPANY LIMITED" & vbNewLine & " 142 Moo 5 Tiwanon Road,Bangkadi," & vbNewLine & "Muang,Pathumthani 12000 Thailand" & vbNewLine & " Tel:(+66)2 105 0456 Ext.1374" & vbNewLine & "Mobile : (+66)86-600-9954" & vbNewLine & "Skype : apimuk_41961 " & vbNewLine & vbNewLine & "apimuk@svi.co.th" & vbNewLine & "http://www.svi-hq.co.th"
strMsg = vbNewLine & "******************************************"
'If the user has canceled the operation.
If vaMsg = False Then Exit Sub
'Add the subject to the outgoing e-mail which also can be retrieved from the users
'in a similar way as above.
stSubject = "RFQ_"
stSubcode = "_" & stcode & "_"
stSubname = stname
stsupplier = stFile
'Retrieve the path and filename of the active workbook.
stAttachment = "C:\Users\PUR_Kannaree\Desktop\File RFQ\p'kant\FILE\File Attachment\" & stFile & ".xlsx"
'Instantiate the Lotus Notes COM's Objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
'If Lotus Notes is not open then open the mail-part of it.
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
'Create the e-mail and the attachment.
Set noDocument = noDatabase.CreateDocument
Set obAttachment = noDocument.CreateRichTextItem("stAttachment")
Set EmbedObject = obAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)
'Add values to the created e-mail main properties.
With noDocument
.Form = "Memo"
.SendTo = vaRecipient
.copyTo = ""
.BlindCopyTo = ""
.Subject = stSubject & Format(Date, " mm/dd/yyyy") & stSubcode & stSubname & stsupplier
.Body = subMsg & vaMsg & signMsg & NameMsg & posMsg & strMsg & contMsg & strMsg
.SaveMessageOnSend = True
End With
'Send the e-mail.
With noDocument
.PostedDate = Now()
.Send 0, vaRecipient
End With
'Release objects from the memory.
Set EmbedObject = Nothing
Set obAttachment = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing
'Activate Excel for the user.
AppActivate "Microsoft Excel"
'MsgBox "The e-mail has successfully been created and distributed.", vbInformation
'End With
Next j
End If
End If
Next i
'---- Commodity "32" ----------------------------------------------------------------------------------------------------'
Dim tw As Integer
If rng = "32" Then
With ws2
On Error Resume Next 'add this because if value is not found, vlookup fails, you get 1004
Stcustomer = Application.WorksheetFunction.VLookup(rng, ws1.Range("B2:P3000").Value, 2, False)
MsgBox Stcustomer
StApp = Application.WorksheetFunction.VLookup(rng, ws1.Range("B2:P3000").Value, 3, False)
MsgBox StApp
Stduedate = Application.WorksheetFunction.VLookup(rng, ws1.Range("B2:P3000").Value, 4, False)
MsgBox Stduedate
On Error GoTo 0
End With
For tw = 1 To 1
MsgBox tw
If tw = 1 Then
stcode = "1500259"
stname = "GOKO"
MyStringVar1 = "kannaree.wawa@gmail.com"
End If
If MyStringVar1 = "" Then
MsgBox "Item not found"
End If
'Check if the active workbook is saved or not
'If the active workbook has not been saved at all.
If Len(ActiveWorkbook.Path) = 0 Then
MsgBox stMsg, vbInformation, stTitle
Exit Sub
End If
'If the changes in the active workbook has been saved or not.
If ActiveWorkbook.Saved = False Then
If MsgBox("Do you want to save the changes before sending?", _
vbYesNo + vbInformation, stTitle) = vbYes Then _
ActiveWorkbook.Save
End If
'Get the name of the recipient from the user.
vaRecipient = MyStringVar1
'Array("Joe_Boe@somewhere.com", "kristen_Dean@somewhere.com", "john_doe@somewhereelse.com", "jane.doe@anotherplace.com")
'If the user has canceled the operation.
If vaRecipient = False Then Exit Sub
'Get the message from the user.
subMsg = "Dear Supplier," & vbNewLine
vaMsg = vbNewLine & " " & "Customer Name : " & Stcustomer & vbNewLine & " " & "Application : " & StApp & vbNewLine & " " & "Due date : " & Stduedate & vbNewLine & " " & vbNewLine & "*** Please open the file attachment for update then reply email ***" & vbNewLine
signMsg = vbNewLine & vbNewLine & vbNewLine & "Best regards,"
NameMsg = vbNewLine & vbNewLine & vbNewLine & " " & "> Apimuk Hattakit <"
posMsg = vbNewLine & "Sourcing Engineer (Plastic)"
contMsg = vbNewLine & "SVI PUBLIC COMPANY LIMITED" & vbNewLine & " 142 Moo 5 Tiwanon Road,Bangkadi," & vbNewLine & "Muang,Pathumthani 12000 Thailand" & vbNewLine & " Tel:(+66)2 105 0456 Ext.1374" & vbNewLine & "Mobile : (+66)86-600-9954" & vbNewLine & "Skype : apimuk_41961 " & vbNewLine & vbNewLine & "apimuk@svi.co.th" & vbNewLine & "http://www.svi-hq.co.th"
strMsg = vbNewLine & "******************************************"
'If the user has canceled the operation.
If vaMsg = False Then Exit Sub
'Add the subject to the outgoing e-mail which also can be retrieved from the users
'in a similar way as above.
stSubject = "RFQ_"
stSubcode = "_" & stcode & "_"
stSubname = stname
stsupplier = stFile
'Retrieve the path and filename of the active workbook.
stAttachment = "C:\Users\PUR_Kannaree\Desktop\File RFQ\p'kant\FILE\File Attachment\" & stFile & ".xlsx"
'Instantiate the Lotus Notes COM's Objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
'If Lotus Notes is not open then open the mail-part of it.
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
'Create the e-mail and the attachment.
Set noDocument = noDatabase.CreateDocument
Set obAttachment = noDocument.CreateRichTextItem("stAttachment")
Set EmbedObject = obAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)
'Add values to the created e-mail main properties.
With noDocument
.Form = "Memo"
.SendTo = vaRecipient
.copyTo = ""
.BlindCopyTo = ""
.Subject = stSubject & Format(Date, " mm/dd/yyyy") & stSubcode & stSubname & stsupplier
.Body = subMsg & vaMsg & signMsg & NameMsg & posMsg & strMsg & contMsg & strMsg
.SaveMessageOnSend = True
End With
'Send the e-mail.
With noDocument
.PostedDate = Now()
.Send 0, vaRecipient
End With
'Release objects from the memory.
Set EmbedObject = Nothing
Set obAttachment = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing
'Activate Excel for the user.
AppActivate "Microsoft Excel"
Next tw
End If
'---- Commodity "26M" -----------------------------------------------------------------------------------------------------
If rng = "26M" Then
With ws2
On Error Resume Next 'add this because if value is not found, vlookup fails, you get 1004
Stcustomer = Application.WorksheetFunction.VLookup(rng, ws1.Range("B2:P3000").Value, 2, False)
MsgBox Stcustomer
StApp = Application.WorksheetFunction.VLookup(rng, ws1.Range("B2:P3000").Value, 3, False)
MsgBox StApp
Stduedate = Application.WorksheetFunction.VLookup(rng, ws1.Range("B2:P3000").Value, 4, False)
MsgBox Stduedate
On Error GoTo 0
End With
stcode = "1500xxx"
stname = "YYYYY"
MyStringVar1 = "kannaree@svi.co.th"
End If
'Check if the active workbook is saved or not
'If the active workbook has not been saved at all.
If Len(ActiveWorkbook.Path) = 0 Then
MsgBox stMsg, vbInformation, stTitle
Exit Sub
End If
'If the changes in the active workbook has been saved or not.
If ActiveWorkbook.Saved = False Then
If MsgBox("Do you want to save the changes before sending?", _
vbYesNo + vbInformation, stTitle) = vbYes Then _
ActiveWorkbook.Save
End If
'Get the name of the recipient from the user.
vaRecipient = MyStringVar1
'Array("Joe_Boe@somewhere.com", "kristen_Dean@somewhere.com", "john_doe@somewhereelse.com", "jane.doe@anotherplace.com")
'If the user has canceled the operation.
If vaRecipient = False Then Exit Sub
'Get the message from the user.
subMsg = "Dear Supplier," & vbNewLine
vaMsg = vbNewLine & " " & "Customer Name : " & Stcustomer & vbNewLine & " " & "Application : " & StApp & vbNewLine & " " & "Due date : " & Stduedate & vbNewLine & " " & vbNewLine & "*** Please open the file attachment for update then reply email ***" & vbNewLine
signMsg = vbNewLine & vbNewLine & vbNewLine & "Best regards,"
NameMsg = vbNewLine & vbNewLine & vbNewLine & " " & "> Apimuk Hattakit <"
posMsg = vbNewLine & "Sourcing Engineer (Plastic)"
contMsg = vbNewLine & "SVI PUBLIC COMPANY LIMITED" & vbNewLine & " 142 Moo 5 Tiwanon Road,Bangkadi," & vbNewLine & "Muang,Pathumthani 12000 Thailand" & vbNewLine & " Tel:(+66)2 105 0456 Ext.1374" & vbNewLine & "Mobile : (+66)86-600-9954" & vbNewLine & "Skype : apimuk_41961 " & vbNewLine & vbNewLine & "apimuk@svi.co.th" & vbNewLine & "http://www.svi-hq.co.th"
strMsg = vbNewLine & "******************************************"
'If the user has canceled the operation.
If vaMsg = False Then Exit Sub
'Add the subject to the outgoing e-mail which also can be retrieved from the users
'in a similar way as above.
stSubject = "RFQ_"
stSubcode = "_" & stcode & "_"
stSubname = stname
stsupplier = stFile
'Retrieve the path and filename of the active workbook.
stAttachment = "C:\Users\PUR_Kannaree\Desktop\File RFQ\p'kant\FILE\File Attachment\" & stFile & ".xlsx"
'Instantiate the Lotus Notes COM's Objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
'If Lotus Notes is not open then open the mail-part of it.
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
'Create the e-mail and the attachment.
Set noDocument = noDatabase.CreateDocument
Set obAttachment = noDocument.CreateRichTextItem("stAttachment")
Set EmbedObject = obAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)
'Add values to the created e-mail main properties.
With noDocument
.Form = "Memo"
.SendTo = vaRecipient
.copyTo = ""
.BlindCopyTo = ""
.Subject = stSubject & Format(Date, " mm/dd/yyyy") & stSubcode & stSubname & stsupplier
.Body = subMsg & vaMsg & signMsg & NameMsg & posMsg & strMsg & contMsg & strMsg
.SaveMessageOnSend = True
End With
'Send the e-mail.
With noDocument
.PostedDate = Now()
.Send 0, vaRecipient
End With
'Release objects from the memory.
Set EmbedObject = Nothing
Set obAttachment = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing
'Activate Excel for the user.
AppActivate "Microsoft Excel"
'----------------------------------------------------------------------------------------------------------------------------
End If
MsgBox "The e-mail has successfully been created and distributed.", vbInformation
Exit Sub
Wend
End Sub
ใช้การ Loop เข้าไปแต่ละบรรทัดแทนการใช้สูตร Lookup ค่ามา เนื่องจากสูตร Lookup มาได้เพียงค่าเดียวเท่านั้นครับ