基于excel数据的文件收集

Question

我经常创建p/n列表。我需要在excel中为我的业务订购。一旦我弄清楚我需要什么，然后我必须手动收集所有上述文件，以便我可以将它们附加到电子邮件中以发出报价。

有没有一种方法可以根据我在Excel中创建的列表自动搜索和收集我需要的文件？此外，我还收集了两种文件类型(.dxf和.pdf)。

Answer 1

将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 &amp; _
           "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/