Excel VBA-将单元格的内容添加到文件名的第一个空格中

时间:2018-11-01 13:54:21

标签: excel vba

在Excel电子表格上,我有一个指向A3中文件夹的路径,文件名来自A6下方列出的A3文件夹。当我在J列中单击时,现有宏会从活动行中生成带有附件的电子邮件。我需要在此宏中添加一部分代码,该代码还将通过将K1的内容添加到文件名的第一个空格中来重命名该文件,即将“ First Second.pdf”重命名为“ K1 Second.pdf的第一个内容”或“ “第一第二Third.pdf”到“ K1第二第三.pdf的第一内容”

Sub Email_with_attachment()


Dim olApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application")

    Dim olMail As Outlook.MailItem
    Set olMail = olApp.CreateItem(olMailItem)

    '------------------------
        Signature = Environ("appdata") & "\Microsoft\Signatures\"
    If Dir(Signature, vbDirectory) <> vbNullString Then
        Signature = Signature & Dir$(Signature & "*.htm")
    Else:
        Signature = ""
    End If
    Signature = CreateObject("Scripting.FileSystemObject").GetFile(Signature).OpenAsTextStream(1, -2).ReadAll

    '------------------------
    olMail.To = ""
    olMail.CC = ""
    olMail.VotingOptions = "Buyer resolving with Supplier;Now received/Corrected"
    olMail.Importance = olImportanceHigh
    '
    olMail.FlagRequest = "Reply"
    olMail.FlagDueBy = Range("H1").Value
'    olMail.OriginatorDeliveryReportRequested = True
'    olMail.ReadReceiptRequested = True
    '
    olMail.Subject = "Invoice issue: " & Range("A" & (ActiveCell.Row)).Value
    olMail.BodyFormat = olFormatHTML

    olMail.HTMLBody = "<HTML><BODY>Hello, <br /><br />Should this have been received by now?<br /><br /> Use Voting buttons above to reply, for convenience. </BODY></HTML>" & Signature


    olMail.Attachments.Add Range("A3") & Range("A" & (ActiveCell.Row)).Value
    olMail.Display

End Sub

1 个答案:

答案 0 :(得分:0)

仅在Attachments.Add行之前,您需要重命名文件。因此,您可以执行以下操作:

OldFilename = Range("A3") & Range("A" & (ActiveCell.Row))
NewFilename = Range("A3") & Mid(Range("A" & (ActiveCell.Row)), 1, 6) & Range("K1") & " " & Mid(Range("A" & (ActiveCell.Row)), 7)

Name OldFilename As NewFilename
olMail.Attachments.Add NewFilename