发送文件夹作为单独的附件中的所有文件

Question

我试图连接使用从https://www.slipstick.com/developer/macro-send-files-email/这段代码的修改后的版本在不同的邮件文件夹中的所有文件。

Dim fldName As String

Sub SendFilesbyEmail()
' From http://slipstick.me/njpnx
Dim sFName As String

i = 0
fldName = "C:\Users\Test"
sFName = Dir(fldName)
Do While Len(sFName) > 0
'filter for only *.txt
  If Right(sFName, 4) = ".txt" Then
      Call SendasAttachment(sFName)
      i = i + 1
  End If
  sFName = Dir
Loop
MsgBox i & " files were sent"
End Sub

Function SendasAttachment(fName As String)

Dim olApp As Outlook.Application
Dim olMsg As Outlook.MailItem
Dim olAtt As Outlook.Attachments

Dim localfName As String
Dim localfldName As String

Set olApp = Outlook.Application
Set olMsg = olApp.CreateItem(0) ' email
Set olAtt = olMsg.Attachments

' attach file
olAtt.Add (fldName & fName)
localfName = fName

   ' send message
With olMsg
  .Subject = "PDF Import: " & Left(localfName, Len(localfName) - 4)
  .To = "[email protected]"
  .HTMLBody = "Test"
  .Send
End With
End Function

这个问题带有试图把文件名到电子邮件主题。

.Subject = "PDF Import: " & Left(localfName, Len(localfName) - 4)

如果我从主题除去localfName，送一个通用的主题为所有的电子邮件，代码工作正常。

当我把要么FNAME或localfName（我试图调试的问题），第一封电子邮件发送，但在第二次迭代中，DIR功能从不同的文件夹返回一个文件名，并且代码中断，因为该文件它试图连接无法找到。

Answer 1

我会用一个文件系统对象，然后遍历像下面的目录中的所有文件：

Sub SendFilesbyEmail()
    Dim objFSO as object
    Dim objFldr as Object
    Dim objFile  as Object

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFldr = objFSO.GetFolder("C:\Users\Test")

    For Each objFile In objFldr.Files 
        strFullPath = objFldr.Path  & "\" & objFile.Name

        If LCase(Trim(objFSO.GetExtensionName(strFullPath))) = "txt" Then
            SendasAttachment(strFullPath)
        End If
    Next


    set objFldr = nothing
    set objFSO = nothing
End Sub


Function SendasAttachment(fullPath As String)

    Dim olApp As Outlook.Application
    Dim olMsg As Outlook.MailItem
    Dim olAtt As Outlook.Attachments

    Dim localfName As String
    Dim localfldName As String

    Set olApp = Outlook.Application
    Set olMsg = olApp.CreateItem(0) ' email
    Set olAtt = olMsg.Attachments

    ' attach file
    olAtt.Add (fullPath)
    localfName = fName

      '  send message
    With olMsg
      .Subject = "PDF Import: " & Left(fullPath, Len(fullPath) - 4)
      .To = "[email protected]"
      .HTMLBody = "Test"
      .Send
    End With
End Function