vba email attachment name

Pinaceous

Pinaceous

Well-known Member
Joined
Jun 11, 2014
Messages
1,124
Office Version
  1. 365
Platform
  1. Windows
Hi All,

I'm working on a sub, which attaches This Workbook file as the attachment in the proposed outlook email pop-up:


VBA Code: 
Sub SendingEmail()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim SigString As String
    Dim Signature As String
 
    'Dim strAppend As String
    'Dim strEmailWb As String
    'strEmailWb = ThisWorkbook.FullName
    'strEmailWb = Replace(strEmailWb, ".xlsm", strAppend & ".xlsm")
 
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
  
    strbody = "Hi Team,</H3>" & _
    "Please see attached file for the day.</H3>" & _
    "<br><br>Thank you!"
    SigString = Environ("appdata") & _
    "\Microsoft\Signatures\Untitled.htm"
    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
      
      
    End If
  
    On Error Resume Next
  
    With OutMail
        .to = "XYZ@something.com"
        .CC = " "
        .Subject = Worksheets(1).Range("A53").Value
      
      
        .HTMLBody = strbody & "<br>" & Signature
        '.Attachments.Add strEmailWb
        .Attachments.Add ThisWorkbook.FullName
     
     
        .Display
    End With
  
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
 
End Sub

Function GetBoiler(ByVal sFile As String) As String
  
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function

However, in using SharePoint the filename is being altered/changed.

For example, when I run the code upon the workbook that I'm using it's titled: "FY23 TOTALS STUFF .xlsm" but when I run the code it attaches it as : "FY23%20TOTALS%20STUFF%20.xlsm".

Can someone help me with this code to send the "FY23 TOTALS STUFF .xlsm" filename in lieu of the "FY23%20TOTALS%20STUFF%20.xlsm"?


Please let me know.

Thank you!

Respectfully,
pinaceous
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
Sort by date Sort by votes
Pinaceous said:
Hi All,

I'm working on a sub, which attaches This Workbook file as the attachment in the proposed outlook email pop-up:


VBA Code: 
Sub SendingEmail()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim SigString As String
    Dim Signature As String
 
    'Dim strAppend As String
    'Dim strEmailWb As String
    'strEmailWb = ThisWorkbook.FullName
    'strEmailWb = Replace(strEmailWb, ".xlsm", strAppend & ".xlsm")
 
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
 
    strbody = "Hi Team,</H3>" & _
    "Please see attached file for the day.</H3>" & _
    "<br><br>Thank you!"
    SigString = Environ("appdata") & _
    "\Microsoft\Signatures\Untitled.htm"
    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    
    
    End If
 
    On Error Resume Next
 
    With OutMail
        .to = "XYZ@something.com"
        .CC = " "
        .Subject = Worksheets(1).Range("A53").Value
    
    
        .HTMLBody = strbody & "<br>" & Signature
        '.Attachments.Add strEmailWb
        .Attachments.Add ThisWorkbook.FullName
   
   
        .Display
    End With
 
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
 
End Sub

Function GetBoiler(ByVal sFile As String) As String
 
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function

However, in using SharePoint the filename is being altered/changed.

For example, when I run the code upon the workbook that I'm using it's titled: "FY23 TOTALS STUFF .xlsm" but when I run the code it attaches it as : "FY23%20TOTALS%20STUFF%20.xlsm".

Can someone help me with this code to send the "FY23 TOTALS STUFF .xlsm" filename in lieu of the "FY23%20TOTALS%20STUFF%20.xlsm"?


Please let me know.

Thank you!

Respectfully,
pinaceous
Click to expand...
You need to download your SharePoint file (ThisWorkbook.SaveCopyAs) to a temp folder, then URL decode the file name.

VBA Code: 
Sub
    ...
    Dim strTempFile As String
    strTempFile = Environ$("TEMP") & "\" & URLDecode(ThisWorkbook.Name)
    ThisWorkbook.SaveCopyAs strTempFile
    'Attach the temp file to the new email
    ...
    With OutMail
        ...
        .Attachments.Add strTempFile
        .Display
    End With
    'Delete the temp file (it's not needed anymore)
    Dim objFSO As Object
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    objFSO.DeleteFile(strTempFile)
End Sub

'Source: excelvba.ru
Private Function URLDecode(ByVal strIn As String) As String
    On Error Resume Next
    Dim sl&, tl&, Key$, kl&
    sl = 1:    tl = 1: Key = "%": kl = Len(Key)
    sl = InStr(sl, strIn, Key, 1)
    Do While sl > 0
        If (tl = 1 And sl <> 1) Or tl < sl Then
            URLDecode = URLDecode & Mid(strIn, tl, sl - tl)
        End If
        Dim hh$, hi$, hl$, a$
        Select Case UCase(Mid(strIn, sl + kl, 1))
            Case "U"    'Unicode URLEncode
                a = Mid(strIn, sl + kl + 1, 4)
                URLDecode = URLDecode & ChrW("&H" & a)
                sl = sl + 6
            Case "E"    'UTF-8 URLEncode
                hh = Mid(strIn, sl + kl, 2)
                a = Int("&H" & hh)    'ascii?
                If Abs(a) < 128 Then
                    sl = sl + 3
                    URLDecode = URLDecode & Chr(a)
                Else
                    hi = Mid(strIn, sl + 3 + kl, 2)
                    hl = Mid(strIn, sl + 6 + kl, 2)
                    a = ("&H" & hh And &HF) * 2 ^ 12 Or ("&H" & hi And &H3F) * 2 ^ 6 Or ("&H" & hl And &H3F)
                    If a < 0 Then a = a + 65536
                    URLDecode = URLDecode & ChrW(a)
                    sl = sl + 9
                End If
            Case Else    'Asc URLEncode
                hh = Mid(strIn, sl + kl, 2)    '??
                a = Int("&H" & hh)    'ascii?
                If Abs(a) < 128 Then
                    sl = sl + 3
                Else
                    hi = Mid(strIn, sl + 3 + kl, 2)    '??
                    'a = Int("&H" & hh & hi) '?ascii?
                    a = (Int("&H" & hh) - 194) * 64 + Int("&H" & hi)
                    sl = sl + 6
                End If
                URLDecode = URLDecode & ChrW(a)
        End Select
        tl = sl
        sl = InStr(sl, strIn, Key, 1)
    Loop
    URLDecode = URLDecode & Mid(strIn, tl)
End Function
 
Upvote 1
Hello pinaceous,

It sounds like what you are experiencing is caused by the SharePoint URL encoding the spaces in the file name, replacing them with %20. You can work around this by saving a temporary copy of the workbook with a sanitized file name before attaching it to the email.

In a nutshell, the code does the following:
  1. Before sending the email, it saves a temporary copy of the workbook in the system's temp folder with a sanitized filename. Spaces in the original file name are replaced with underscores.
  2. Attaches the temporary file to the email instead of the original workbook.
  3. After the email is displayed, the temporary file is deleted from the system's temp folder.
This should resolve the issue with SharePoint URL encoding the spaces in the file name.


VBA Code: 
Sub SendingEmail()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim SigString As String
    Dim Signature As String
    Dim tempFile As String
 
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
 
    strbody = "Hi Team,</H3>" & _
    "Please see attached file for the day.</H3>" & _
    "<br><br>Thank you!"
    SigString = Environ("appdata") & _
    "\Microsoft\Signatures\Untitled.htm"
    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If
 
    ' Save a temporary copy of the workbook with a sanitized filename
    tempFile = Environ("TEMP") & "\" & Replace(ThisWorkbook.Name, " ", "_")
    ThisWorkbook.SaveCopyAs tempFile
 
    On Error Resume Next
 
    With OutMail
        .to = "XYZ@something.com"
        .CC = " "
        .Subject = Worksheets(1).Range("A53").Value
        .HTMLBody = strbody & "<br>" & Signature
        .Attachments.Add tempFile
        .Display
    End With
 
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing

    ' Delete the temporary file
    Kill tempFile

End Sub

Function GetBoiler(ByVal sFile As String) As String
 
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question Question
Email file VBA - change attachment from excel to PDF?
Replies
2
Views
233
MOB
M
B
  • Question Question
font size in outlook email (12 points doesn't work)
2
Replies
13
Views
272
basb87
B
O
  • Question Question
Add Signature to Email Macro
Replies
1
Views
293
starl
starl
S
  • Solved
Tweak to VBA email code
Replies
3
Views
718
rollis13
rollis13
B
  • Solved
VBA to email recipient if column cells contain value
Replies
6
Views
475
bh24524
B

Forum statistics

Threads
1,223,236
Messages
6,170,906
Members
452,366
Latest member
TePunaBloke

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top