我经常创建p / n列表。我需要在excel订购我的业务。一旦我弄清楚我需要什么,然后我必须手动收集所有所述文件,因此我可以将它们附加到电子邮件中以发送报价。
有没有办法根据我在Excel中创建的列表自动搜索和收集文件?另外,我收集了两种文件类型(.dxf和.pdf)。
答案 0 :(得分:0)
将AttachmentPath
中的文件路径定义为数组。
Const cdoSendUsingPickup = 1 'Send message using the local SMTP service pickup directory.
Const cdoSendUsingPort = 2 'Send the message using the network (SMTP over the network).
Const cdoAnonymous = 0 'Do not authenticate
Const cdoBasic = 1 'basic (clear-text) authentication
Const cdoNTLM = 2 'NTLM
Function SendCDOMail(sTo As String, sSubject As String, sBody As String, _
Optional sBCC As Variant, Optional AttachmentPath As Variant)
On Error GoTo Error_Handler
Dim objCDOMsg As Object
Set objCDOMsg = CreateObject("CDO.Message")
'CDO Configuration
With objCDOMsg.Configuration.Fields
'
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
'Server port (typically 25, 587)
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
'SMTP server IP or Name
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.hitterslongrun.com"
'Type of authentication, NONE, Basic (Base64 encoded), NTLM
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
'SMTP Account User ID
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "accounts@hitterslongrun.com"
'SMTP Account Password
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "Uhdje!@@0#"
'Use SSL for the connection (False or True)
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
.Update
End With
'CDO Message
objCDOMsg.Subject = sSubject
objCDOMsg.From = "accounts@hitterslongrun.com"
objCDOMsg.To = sTo
objCDOMsg.TextBody = sBody
' Add attachments to the message.
If Not IsMissing(AttachmentPath) Then
If IsArray(AttachmentPath) Then
For i = LBound(AttachmentPath) To UBound(AttachmentPath)
If AttachmentPath(i) <> "" And AttachmentPath(i) <> "False" Then
objCDOMsg.AddAttachment AttachmentPath(i)
End If
Next i
Else
If AttachmentPath <> "" And AttachmentPath(i) <> "False" Then
objCDOMsg.AddAttachmentAttachmentPath
End If
End If
End If
objCDOMsg.Send
Error_Handler_Exit:
On Error Resume Next
Set objCDOMsg = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: SendCDOMail" & vbCrLf & _
"Error Description: " & Err.Description, _
vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Function
Reff www.devhut.net/