vba email attachment name

Pinaceous

Pinaceous

Well-known Member
Joined
Jun 11, 2014
Messages
1,113
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

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
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

The Ruff Report
  • Question
Add multiple attachments from email list
Replies
1
Views
278
Trebor76
T
J
  • Solved
Adjust VBA to Include Action Count and Auto Stop
Replies
3
Views
300
mumps
mumps
M
  • Question
Workbook in attachement of Email - specific Xls format . How to ?
Replies
1
Views
292
Fluff
Fluff
J
  • Solved
Emailing active WS as Excel attachment failing
Replies
5
Views
266
NoSparks
N
G
  • Solved
Dynamic Button for Email Macro
Replies
4
Views
216
GarnesGambit
G

Forum statistics

Threads
1,214,973
Messages
6,122,534
Members
449,088
Latest member
RandomExceller01

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