:!: โปรดทราบ Image
    1. กรุณาอ่านกฎการใช้บอร์ด (Forum rules) ในตำแหน่งด้านบนของแต่ละบอร์ดครับ Image
    2. การสมัครสมาชิกเพื่อโพสต์คำถาม ดาวน์โหลดไฟล์แนบไปศึกษา ทำตามขั้นตอนด้านล่างครับ
      1. สมัครสมาชิก ดูขั้นตอนตาม Link นี้ครับ => สมัครสมาชิก กรณีลืมรหัสผ่านสามารถรับรหัสใหม่ได้ที่นี่ครับ => Reset รหัสผ่านImage
      2. Login เข้าระบบโดยคลิก Login ตรงมุมขวาบนของหน้านี้ Image กรณีมีปัญหาในการเข้าใช้งาน คลิก Link นี้เพื่อแจ้งผู้ดูแลระบบครับ => ติดต่อผู้ดูแลระบบ
    3. เมื่อ Login แล้วสามารถกำหนดการตั้งค่าส่วนตัว เช่นตั้งค่าภาษาเป็นไทยหรืออังกฤษได้ที่ Link นี้ครับ => ตั้งค่าส่วนตัว Image
    4. วิธีการตั้งและตอบกระทู้ดูได้ที่ Link นี้ครับ => วิธีการตั้งและตอบกระทู้ Image
    5. การจัดรูปแบบตัวอักษรด้วย bbcode ในช่องแสดงความคิดเห็นดูได้ที่ Link นี้ครับ => จัดรูปแบบตัวอักษร และสามารถกำหนดขนาดตัวอักษรใน Browser ได้ที่นี่ครับ ==> กำหนดขนาดตัวอักษรใน Browser Image

[vba] send auto mail

ฟอรั่มถาม-ตอบปัญหาการใช้งาน MS Excel and VBA
Forum rules
  1. ไม่อนุญาตให้ใช้ภาษาแชทในการถาม-ตอบปัญหา ไม่ใช้คำว่า "คับ" หรือ "อ่ะครับ" แทนคำว่า "ครับ" ไม่ใช้คำว่า "เด๋ว" แทนคำว่า "เดี๋ยว" เป็นต้น เนื่องจากเมื่อแปลเป็นภาษาต่างประเทศแล้วจะให้ความหมายผิดไปจากที่ควรจะเป็น
  2. ห้ามถามโดยระบุชื่อผู้ตอบ ต้องตั้งชื่อกระทู้ให้สื่อถึงปัญหาที่จะถาม ไม่ตั้งชื่อว่า ช่วยด้วยครับ, มีปัญหามาปรึกษาครับ เป็นต้น
  3. อธิบายปัญหาและระบุคำตอบที่ต้องการมาในกระทู้ด้วยเสมอถึงแม้จะอธิบายไว้ในไฟล์แนบแล้วก็ตาม ทั้งนี้เพื่ออำนวยความสะดวกแก่เพื่อนสมาชิกในการค้นหาข้อมูล
  4. ควรแนบตัวอย่างไฟล์มาที่ฟอรั่มนี้เพื่อเพิ่มความสะดวกในการตอบคำถาม (ขนาดไฟล์ไม่เกิน 500Kb ขนาดภาพไม่เกิน 800*600 Pixel) ไม่แนบเป็น Link มาจากแหล่งอื่น นอกจากนี้ไม่ควรแนบไฟลที่มีข้อมูลสำคัญอันก่อให้เกิดความเสียหายกับตนเองและผู้อื่น
  5. สำหรับคำถามเกี่ยวกับ VBA ให้ลองเขียนมาเองก่อนเสมอ ถามเฉพาะที่ติดปัญหา ระบุ Module, Procedure ที่ติดปัญหาให้ชัดเจน ควรโพสต์ Code ให้แสดงเป็น Code เพื่อสะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)
  6. แจ้งผลการใช้งานเมื่อได้รับคำตอบว่าตรงกับความต้องการหรือไม่
kannaree
Member
Member
Posts: 119
Joined: Thu Nov 19, 2015 12:07 pm

[vba] send auto mail

#1

Postby kannaree » Fri Aug 11, 2017 2:06 pm

สวัสดีคะอาจารย์และทุกๆท่าน

ฉันอยากจะทราบว่าเราสามารถ vlookup จากชื่อไฟล์ในโฟลเดอร์ได้หรือไม่ อย่างไรคะ
คือต้องการให้คลิกปุ่ม auto send mail

แล้วให้ vlookup หา file จาก folder ที่เก็บไว้ ถ้าชื่อไฟล์เหมือน column[C] ให้ส่งเมล์ ตาม column [D]

ไม่ทราบว่า สามารถวนลูปได้ในลักษณะไหนคะ พอดีตอนนี้ fixไว้

folder :
1.png


vlookup จาก sheets database
2.png



send e-mail พร้อมแนบไฟล์


3.png


Code :

Code: Select all

'------------------ Send auto e-mail to supplier ---------------------
Private Sub CommandButton5_Click()
   Dim noSession As Object, noDatabase As Object, noDocument As Object
   Dim obAttachment As Object, EmbedObject As Object
   Dim stSubject As Variant, stAttachment As String, stsupplier As String
   
   Dim vaRecipient As Variant, vaMsg As Variant
 
   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."
 
   '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.
'++++++++++++====== send e-mail To ===============================++++++++++++
   
   'Do
  '    vaRecipient = Application.InputBox(_
   '         prompt:="Please add the name of the recipient such as:" & vbCrLf_
   '         & "excel@microsoft.com or just the name if it's internally.",_
   '         Title:="Recipient", Type:=2)
  ' Loop While vaRecipient = ""
   
   
   vaRecipient = "kannaree@svi.co.th" & "," & "svi.kannaree@gmail.com"
   
'++++++++++++=========================================================++++++++++++
   'If the user has canceled the operation.
   If vaRecipient = False Then Exit Sub
 
   'Get the message from the user.
'===== Message Body popup (old) ============================
   'Do
  '    vaMsg = Application.InputBox( _
   '         Prompt:="Please enter the message such as:" & vbCrLf _
   '         & "Enclosed please find the weekly report.", _
   '         Title:="Message", Type:=2)
   'Loop While vaMsg = ""
   
   vaMsg = "Dear Supplier," & vbNewLine _
   & "Please be reminded to submit the price in SupplyWin." & vbNewLine & "Need your prompt response to complete the project within due date." & vbNewLine _
   & "" & vbNewLine & "By the way, you can quote by return email to us." & "" & vbNewLine & vbNewLine & "Please noted that un price or no bidding, please reply with the reason"
   
           
 '++++++++++++=========================================================++++++++++++

   '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 = "RFQunprice"
   stsupplier = "3M THAILAND LIMITED"
   
 
   'Retrieve the path and filename of the active workbook.
    'stAttachment = ActiveWorkbook.FullName
   
    stAttachment = "C:\Users\PUR_Kannaree\Desktop\File RFQ\fon\File send mail\3M THAILAND LIMITED.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
     
      .Subject = stSubject & Format(Date, " mm/dd/yyyy") & "_" & stsupplier
      .Body = vaMsg
      .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 Sub



ขอบคุณค่ะ
You do not have the required permissions to view the files attached to this post.

kannaree
Member
Member
Posts: 119
Joined: Thu Nov 19, 2015 12:07 pm

Re: [vba] send auto mail

#2

Postby kannaree » Fri Aug 11, 2017 2:08 pm

file for test :
Test.rar
You do not have the required permissions to view the files attached to this post.

User avatar
snasui
Site Admin
Site Admin
Posts: 21609
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Contact:

Re: [vba] send auto mail

#3

Postby snasui » Sat Aug 12, 2017 8:40 pm

:D ช่วยแจ้ง Procedure ที่ติดปัญหา บรรทัดที่ติดปัญหา ขั้นตอนการทดสอบ จะได้เข้าถึงปัญหาโดยเร็วครับ

kannaree
Member
Member
Posts: 119
Joined: Thu Nov 19, 2015 12:07 pm

Re: [vba] send auto mail

#4

Postby kannaree » Tue Aug 15, 2017 8:23 am

อยากทราบว่าเราสามารถเอาข้อมูลจาก sheets ไป vlookup กับชื่อไฟล์ได้หรือไม่ อย่างไรคะอาจารย์



ขอบคุณค่ะ

User avatar
snasui
Site Admin
Site Admin
Posts: 21609
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Contact:

Re: [vba] send auto mail

#5

Postby snasui » Tue Aug 15, 2017 9:50 pm

:D สามารถทำได้ครับ

ลักษณะการทำงานคือ Loop เข้าไปยัง Folder ที่ต้องการหากพบไฟล์ตามที่ต้องการจึงจะส่งอีเมล ลองค้นหา Code สำหรับการ Loop ไฟล์ใน Folder มาปรับใช้ดู ติดตรงไหนค่อยถามกันต่อครับ

kannaree
Member
Member
Posts: 119
Joined: Thu Nov 19, 2015 12:07 pm

Re: [vba] send auto mail

#6

Postby kannaree » Fri Aug 18, 2017 3:16 pm

ทำได้แล้วค่ะ อาจารย์แต่ติดปัญหาตรงวนลูป จริง ๆ ตั้งข้อมูลไว้แค่ 3 ลูกค้า
(ตามรูป)
1.png


แต่ข้อมูลส่งเมล์ ติด loop แถมไฟล์ก็ไม่ถูกแนบไป***


2.png


Code: Select all

'------------------ Send auto e-mail to supplier ---------------------
Private Sub CommandButton5_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, 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 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\fon\File send mail\")
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
            'MsgBox "" & fnst
            'MsgBox "" & i
            'MsgBox "" & LastRow
            FName = fnst
               
               If InStr(file, FName) > 0 Then
                  'MsgBox "found " & file
                  stFile = file
                  'Exit Sub
                End If
                                       
                   file = Dir
               
            'Next i
         
        'End If
    'Wend
 
'vlookup send email--------------------------------------------------------------------------------------------------------------------
Dim rng As String
Dim ws1, ws2 As Worksheet
Dim MyStringVar1 As String
Dim r, LastRow1 As Long
Set ws1 = ThisWorkbook.Sheets("Database_supplier")
Set ws2 = ThisWorkbook.Sheets("tempsheet")
 
 With Sheets("tempsheet")
                LastRow1 = Cells(Rows.Count, "A").End(xlUp).Row
            End With
           
                       
           If LastRow1 > 1 Then
               
                For r = 2 To LastRow
                       rng = Range("A" & r).Value
                       'MsgBox "" & rng
                      stFile = rng
                   LastRow1 = LastRow1 - 1
                   MsgBox "" & LastRow1
                   With ws2
                       On Error Resume Next 'add this because if value is not found, vlookup fails, you get 1004
                       MyStringVar1 = Application.WorksheetFunction.VLookup(rng, ws1.Range("C2:D2740").Value, 2, False)
                       On Error GoTo 0
                       If MyStringVar1 = "" Then
                       MsgBox "Item not found"
                       End If
                      'MsgBox MyStringVar1
               
                 
                 
                'End With
    'Next r
 '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 & "             " & "Please be reminded to submit the price in SupplyWin." & vbNewLine & "    " & "Need your prompt response to complete the project within due date." & vbNewLine _
                   & "" & vbNewLine & "    " & "By the way, you can quote by return email to us." & "" & vbNewLine & vbNewLine & "    " & "Please noted that un price or no bidding, please reply with the reason" & vbNewLine
                   
                   signMsg = vbNewLine & vbNewLine & vbNewLine & "Best regards,"
                   
                   NameMsg = vbNewLine & vbNewLine & vbNewLine & "    " & "Ms.Nuttaya sirisongprakob (Prim)  "
                           
                   posMsg = vbNewLine & "    " & "    " & "    " & "Sourcing Officer"
                   
                   contMsg = vbNewLine & "SVI PUBLIC COMPANY LIMITED" & vbNewLine & " Tel. :  +66 2105 0456 ext. 1323" & vbNewLine & " Fax. :  +66 2105 0464-5" & vbNewLine & " E-mail :Nuttaya@svi.co.th" & vbNewLine & "Skype ID :Nuttaya_pp" & vbNewLine & "Website : www.svi.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 = "RFQunprice"
                   stsupplier = stFile
                   
                   'Retrieve the path and filename of the active workbook.
                   
                    stAttachment = "C:\Users\PUR_Kannaree\Desktop\File RFQ\fon\File send mail\" & stFile
                     
                   '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 = ""
                      .Subject = stSubject & Format(Date, " mm/dd/yyyy") & "_" & 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 r
       
    End If
     
            Next i
         
        End If
   
    Wend
   
    MsgBox "The e-mail has successfully been created and distributed.", vbInformation
   
End Sub





* รบกวนขอคำแนะนำจากอาจารย์และผู้มึความรู้ทุกท่านด้วยค่ะ
You do not have the required permissions to view the files attached to this post.

kannaree
Member
Member
Posts: 119
Joined: Thu Nov 19, 2015 12:07 pm

Re: [vba] send auto mail

#7

Postby kannaree » Fri Aug 18, 2017 3:22 pm

แนบไฟล์งานเพื่อทดสอบ

Test.xlsm


1. Click
3.png


2. ระบุ pathfile ที่จะแตกไฟล์แยกตามลูกค้า
4.png
You do not have the required permissions to view the files attached to this post.

kannaree
Member
Member
Posts: 119
Joined: Thu Nov 19, 2015 12:07 pm

Re: [vba] send auto mail

#8

Postby kannaree » Fri Aug 18, 2017 3:24 pm

ต่อ

3.ตัวอย่าง Result ที่ได้ทำการแตกไฟล์
5.png


4. Click ปุ่มเพื่อส่งอีเมล์ อัตโนมัติ *ฟังก์ชั่นที่เกิดปัญหา

6.png


ขอบคุณมากค่ะ
You do not have the required permissions to view the files attached to this post.


Return to “Excel”

Who is online

Users browsing this forum: arron, Google Feedfetcher and 37 guests