Link to home
Start Free TrialLog in
Avatar of mjburgard
mjburgardFlag for United States of America

asked on

Replace .xxx in a variable if it exists. VBA

I am using a macro that will convert a word doc to a pdf and then attach to Outlook to be mailed.  Occasionally, depending on how the document was generated, the name of the pdf will be xxxxx.docx.pdf.
The name of the file is stored in a variable called myfile - I need to replace the .docx with nothing. so that the file is called xxxxx.pdf.
This should be simple, but I don't know VBA very well - yet.  :)


I inherited this code, but it looks like it was downloaded from the net.  Any help would be appreciated.

Attribute VB_Name = "savetopdfplus"
 'Get content control function
    Function getContent(ByRef wdDoc As Word.Document, ccName As String) As String
 For i = 1 To wdDoc.ContentControls.Count
        If wdDoc.ContentControls(i).Title = ccName Then
            getContent = wdDoc.ContentControls(i).Range.Text
            Exit Function
        End If
    Next
    
    getContent = "n/a"
    
End Function


Sub Send_original_and_pdf()
'
' This macro creates a pdf-file of the current document and adds
' both the original and the pdf-version of the document as an
' attachment to a new Outlook message.
'
' This macro requires
' -Word 2007
' -The SaveAsPDFandXPS.exe addin to be installed
' -A reference added to the Microsoft Outlook <version> Object Library
'
' The SaveAsPDFandXPS.exe addin can be downloaded from;
' http://www.microsoft.com/downloads/details.aspx?FamilyId=4D951911-3E7E-4AE6-B059-A2E79ED87041
'

    On Error Resume Next

   

' save the file
    Dim salesman As String, descr As String, day As String
    descr = getContent(Application.ActiveDocument, "description")
    salesman = getContent(Application.ActiveDocument, "salesman")
    day = Format$(Date, "YYYY-MM-DD")
    ActiveDocument.SaveAs FileName:="\\DEV\quotes\" & salesman & "\" & day & "-" & descr

    'Get the name of the open file and strip any extension.
    Dim MyFile As String
    MyFile = ActiveDocument.name
    intPos = InStrRev(MyFile, ".")
    If intPos > 0 Then
        MyFile = Left(MyFile, intPos - 1)
    End If

    'Get the user's TempFolder to store the created pdf item in.
    Dim FSO As Object, TmpFolder As Object
    Set FSO = CreateObject("scripting.filesystemobject")
    Set FileName = FSO.GetSpecialFolder(2)
    
    'Create the full path name for the pdf-file
    FileName = FileName & "\" & MyFile & ".pdf"
 
    'Save the current document as pdf in the user's temp folder.
    'Note that we are going to include the document properties as well.
    'If you do not want this set "IncludeDocProps" to False.
    ActiveDocument.ExportAsFixedFormat OutputFileName:= _
        FileName, 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

    'Declare an Outlook application an a mail item.
    Dim oOutlookApp As Outlook.Application
    Dim oItem As Outlook.MailItem

    'Start Outlook if it isn't running.
    Set oOutlookApp = GetObject(, "Outlook.Application")
    If Err <> 0 Then
        Set oOutlookApp = CreateObject("Outlook.Application")
    End If

    'Create a new message.
    Set oItem = oOutlookApp.CreateItem(olMailItem)
        With oItem
            .To = getContent(ActiveDocument, "email")
            .Subject = ActiveDocument.name
        End With
        
        
    'Add the attachments.
    oItem.Attachments.Add FileName
   

    'Show the message.
    oItem.Display
    
    'Cleanup
    Set FSO = Nothing
    Set FileName = Nothing
    Set oOutlookApp = Nothing
    Set oItem = Nothing
    

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of Ryan Chong
Ryan Chong
Flag of Singapore image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of mjburgard

ASKER

Awesome, thanks