2

我不知道如何让这件事超出这一点。我下面的代码会发送一封电子邮件，其中包含 MS Access 2010 的附件。

问题是如果它需要一个固定的文件名，我的文件名会随着我使用每个文件末尾的日期而改变。例如：green_12_04_2012.csv。如果文件夹为空或目录更改，我也不知道如何使它不会失败。如果它只是跳到下一个子而不是崩溃，那就太好了。

我的代码：

Dim strGetFilePath As String
Dim strGetFileName As String

strGetFilePath = "C:\datafiles\myfolder\*.csv"

strGetFileName = Dir(strGetFilePath)

Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
With MailOutLook
    .BodyFormat = olFormatRichText
    .To = "bob@builder.com"
    ''.cc = ""
    ''.bcc = ""
    .Subject = "text here"
    .HTMLBody = "text here"
    .Attachments.Add (strGetFileName & "*.csv")
    .Send
End With
End Sub

我想我快到了。

4

2 回答 2

3

我找到了一个合适的解决方案，除了发布的解决方案之外，我还想添加这个以防万一有人在寻找解决方案。我一直到凌晨 3 点，这是一个非常受欢迎的问题，但没有任何关于循环附加特定文件夹中的所有文件的解决方案。

这是代码：

Public Sub sendEmail()
    Dim appOutLook As Outlook.Application
    Dim MailOutLook As Outlook.MailItem
    Dim strPath As String
    Dim strFilter As String
    Dim strFile As String

    strPath = "C:\Users\User\Desktop\"      'Edit to your path
    strFilter = "*.csv"
    strFile = Dir(strPath & strFilter)

    If strFile <> "" Then

        Set appOutLook = CreateObject("Outlook.Application")
        Set MailOutLook = appOutLook.CreateItem(olMailItem)

        With MailOutLook
            .BodyFormat = olFormatRichText
            .To = "bob@builder.com"
            ''.cc = ""
            ''.bcc = ""
            .Subject = "text here"
            .HTMLBody = "text here"
            .Attachments.Add (strPath & strFile)
            .Send
            '.Display    'Used during testing without sending (Comment out .Send if using this line)
        End With
    Else
        MsgBox "No file matching " & strPath & strFilter & " found." & vbCrLf & _
                "Processing terminated.
        Exit Sub    'This line only required if more code past End If
    End If

End Sub
于 2012-12-05T17:42:48.047 回答
0

这是我在一个论坛上找到的代码，不记得在哪里，但我稍微修改了一下，这给了你文件的完整路径，它使用通配符搜索文件夹和子文件夹

Function fSearchFileWild(FileName As String, Extenstion As String)
Dim strFileName As String
Dim strDirectory As String

strFileName = "*" & FileName & "*." & Extenstion
strDirectory = "C:\Documents and Settings\"

fSearchFileWild = ListFiles(strDirectory, strFileName, True)

End Function

Public Function ListFiles(strPath As String, Optional strFileSpec As String, _
    Optional bIncludeSubfolders As Boolean, Optional lst As ListBox)
On Error GoTo Err_Handler

Dim colDirList As New Collection
Dim varItem As Variant

Call FillDir(colDirList, strPath, strFileSpec, bIncludeSubfolders)

Dim counter As Integer
counter = 0
Dim file1 As String
Dim file2 As String
Dim file3 As String


For Each varItem In colDirList
    If file1 = "" Then
    file1 = varItem
    counter = 1
    ElseIf file2 = "" Then
    file2 = varItem
    counter = 2
    ElseIf file3 = "" Then
    file3 = varItem
    counter = 3
    End If
Next
'if there is more than 1 file, msgbox displays first 3 files
If counter = 1 Then
ListFiles = file1
ElseIf counter > 1 Then
MsgBox "Search has found Multiple files for '" & strFileSpec & "', first 3 files are: " & vbNewLine _
        & vbNewLine & "file1: " & file1 & vbNewLine _
        & vbNewLine & "file2: " & file2 & vbNewLine _
        & vbNewLine & "file3: " & file3
ListFiles = "null"
Else
ListFiles = "null"
End If



Exit_Handler:

    Exit Function


Err_Handler:

    MsgBox "Error " & Err.Number & ": " & Err.Description

    Resume Exit_Handler

End Function

Private Function FillDir(colDirList As Collection, ByVal strFolder As String, strFileSpec As String, _
    bIncludeSubfolders As Boolean)
    'Build up a list of files, and then add add to this list, any additional folders
    Dim strTemp As String
    Dim colFolders As New Collection
    Dim vFolderName As Variant

    'Add the files to the folder.
    strFolder = TrailingSlash(strFolder)
    strTemp = Dir(strFolder & strFileSpec)
    Do While strTemp <> vbNullString
        colDirList.Add strFolder & strTemp
        strTemp = Dir
    Loop

    If bIncludeSubfolders Then
        'Build collection of additional subfolders.
        strTemp = Dir(strFolder, vbDirectory)
        Do While strTemp <> vbNullString
            If (strTemp <> ".") And (strTemp <> "..") Then
                If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0& Then
                    colFolders.Add strTemp
                End If
            End If
            strTemp = Dir
        Loop
        'Call function recursively for each subfolder.
        For Each vFolderName In colFolders
            Call FillDir(colDirList, strFolder & TrailingSlash(vFolderName), strFileSpec, True)
        Next vFolderName
    End If
End Function

Public Function TrailingSlash(varIn As Variant) As String
    If Len(varIn) > 0& Then
        If Right(varIn, 1&) = "\" Then
            TrailingSlash = varIn
        Else
            TrailingSlash = varIn & "\"
        End If
    End If
End Function
于 2012-12-05T04:31:58.107 回答