在 VBA 中连接字符串时的奇怪行为答案

【问题标题】：strange behavior when concatenating strings in VBA在 VBA 中连接字符串时的奇怪行为
【发布时间】：2020-06-05 06:19:15
【问题描述】：

这就是我想要做的。

我们偶尔会收到包含以下信息的电子邮件：

名称：在 ( 和 - 之间的主题行中

DoB：在电子邮件正文中：

接收电子邮件的日期：在邮件本身中。

我可以很容易地获得名称和日期，但是当我尝试将 DoB 添加到文件名时，它的行为很奇怪，它通常会丢弃我提取的名称。

这是我正在使用的代码：

Sub SaveAsPDF(MyMail As MailItem)
' ### Requires reference to Microsoft Scripting Runtime ###
' ### Requires reference to Microsoft Word Object Library ###
' --- In VBE click TOOLS > REFERENCES and check the boxes for both of the above ---
Dim fso As FileSystemObject
Dim strSubject As String
Dim strSaveName As String
Dim blnOverwrite As Boolean
Dim strFolderPath As String
Dim sendEmailAddr As String
Dim clientName As String
Dim openPos1 As Integer
Dim closePos1 As Integer
Dim openPos2 As Integer
Dim closePos2 As Integer
Dim senderName As String
Dim looper As Integer
Dim plooper As Integer
Dim strID As String
Dim olNS As Outlook.NameSpace
Dim oMail As Outlook.MailItem
Dim bDay As String


strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set oMail = olNS.GetItemFromID(strID)
emailSubject = CleanFileName(oMail.Subject)

' ### Get username portion of sender email address  ###
sendEmailAddr = oMail.SenderEmailAddress
senderName = Left(sendEmailAddr, InStr(sendEmailAddr, "@") - 1)

' ### Get Client birthday ###
openPos1 = InStr(oMail.Body, "DOB:")
closePos1 = InStr(oMail.Body, "TLF:")
bDay = Mid(oMail.Body, openPos1 + 12, closePos1 - openPos1 - 12)



' ### USER OPTIONS ###
blnOverwrite = False ' False = don't overwrite, True = do overwrite

' ### Path to save directory ###
bPath = "C:\Email test\"

' ### Create Directory if it doesnt exist ###
If Dir(bPath, vbDirectory) = vbNullString Then
    MkDir bPath
End If

' ### Get Email subject & set name to be saved as ###
saveName = clientName & " " & Format(oMail.ReceivedTime, "dd-mm-yyyy") & ".mht"
Set fso = CreateObject("Scripting.FileSystemObject")

' ### Get the client name from the email subject ###
openPos2 = InStr(emailSubject, "(")
closePos2 = InStr(emailSubject, "-")
clientName = Mid(emailSubject, openPos2 + 1, closePos2 - openPos2 - 1)
' ### Increment filename if it already exists ###
If blnOverwrite = False Then
    looper = 0
    Do While fso.FileExists(bPath & saveName)
        looper = looper + 1
        saveName = clientName & " " & Format(oMail.ReceivedTime, "dd-mm-yyyy") & " " & looper & ".mht"
        Loop
Else
End If

' ### Save .mht file to create pdf from Word ###
oMail.SaveAs bPath & saveName, olMHTML
    pdfSave = bPath & clientName & " " & Format(oMail.ReceivedTime, "dd-mm-yyyy") & ".pdf"
If fso.FileExists(pdfSave) Then
    plooper = 0
    Do While fso.FileExists(pdfSave)
    plooper = plooper + 1
    pdfSave = bPath & clientName & " " & Format(oMail.ReceivedTime, "dd-mm-yyyy") & " " & plooper & ".pdf"
    Loop
Else
End If


' ### Open Word to convert .mht file to PDF ###
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Set wrdApp = CreateObject("Word.Application")

' ### Open .mht file we just saved and export as PDF ###
Set wrdDoc = wrdApp.Documents.Open(FileName:=bPath & saveName, Visible:=True)
wrdApp.ActiveDocument.ExportAsFixedFormat OutputFileName:= _
            pdfSave, ExportFormat:= _
            wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
            wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=0, To:=0, _
            Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
            CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
            BitmapMissingFonts:=True, UseISO19005_1:=False

wrdDoc.Close
wrdApp.Quit

' ### Delete .mht file ###
Kill bPath & saveName


Set oMail = Nothing
Set olNS = Nothing
Set fso = Nothing
End Sub

这将保存一个名为“Marty Smith 04-06-2020”的 PDF 文件，但是如果我将字符串“bDay”添加到文件名中，它将忽略名称和 DOB，只添加日期，但 Word 将无法保存并在后台进程中挂起。

' ### Save .mht file to create pdf from Word ###
oMail.SaveAs bPath & saveName, olMHTML
    pdfSave = bPath & clientName & " " & bDay & " " & Format(oMail.ReceivedTime, "dd-mm-yyyy") & ".pdf"
If fso.FileExists(pdfSave) Then
    plooper = 0
    Do While fso.FileExists(pdfSave)
    plooper = plooper + 1
    pdfSave = bPath & clientName & " " & bDay & " " & Format(oMail.ReceivedTime, "dd-mm-yyyy") & " " & plooper & ".pdf"
    Loop
Else
End If

【问题讨论】：

bDay 中可能至少有一个字符在文件名中无效。尝试使用Debug.Print 输出文件名并检查它是否符合您的预期。
您将邮件正文的一部分分配给bDay - 可能您在其中包含无效字符，例如换行符。在设置变量并检查其中的内容后，添加类似 Debug.Print "[" & bDay & "]" 的语句。
是的。看起来我在那里有 2 个新行。不知道如何，但是，因为我以为我只得到了 DOB，并且摆弄这些职位似乎并没有摆脱它。有什么办法可以清理输出？
由于生日可能没有换行符，因此您可能会放弃这些职位。但是，如果您无法弄清楚：您可以使用像 bDay = Replace(Replace(bDay, vbCr, ""), vbLf, "") 这样的简单语句。
我发现我错了，我在减少错误的位置。将 14 添加到 ClosePos 就可以了。

标签： vba string outlook save string-concatenation

【解决方案1】：

我对 InStr 的关闭位置包括来自电子邮件正文的 2 个换行符，当我通过 Msgbox 显示输出时，这对我来说并不明显。

Debug.Print bDay 帮助我了解问题所在并调整 closePos 变量以删除换行符。

【讨论】：