Need a little help

[realitydrm]

Hello all. I'm new to VBA and I'm trying to automate a process. I want to save a word document as the file name from my the content control boxes for license plate number first than customer name and I would like to save it to a particular location, close it out and open a new outlook email that has the text i chose in the subject line. Here is what i have so far:

Dim strFilename As String
strText = ThisDocument.SelectContentControlsByTitle("License Plate Number")(1).Range.Text
strText = ThisDocument.SelectContentControlsByTitle("Customer Name")(1).Range.Text

Dim strFilename As String
strFilename = strText & ("License Plate Number") & ("Customer Name") & ".docx"


ThisDocument.SaveAs strFilename

[gmayor]

You need to make better use of the variables e.g. as follows, though do note that the following will save in the currently active document folder, makes no correction for illegal filenames and will overwrite any existing file of the same name present in the folder. To accommodate those issues see the CleanFilename, FileNameUnique and BrowseforFolder functions at http://www.gmayor.com/useful_vba_functions.htm

Sub SaveExample()
Dim strPlate As String
Dim strName As String
Dim strFilename As String
Dim oCC As ContentControl

    On Error GoTo err_Handler
    Set oCC = ActiveDocument.SelectContentControlsByTitle("License Plate Number").Item(1)
    If oCC.ShowingPlaceholderText Then
        MsgBox "Complete the License plate number!"
        oCC.Range.Select
        GoTo lbl_Exit
    Else
        strPlate = oCC.Range.Text
    End If

    Set oCC = ActiveDocument.SelectContentControlsByTitle("Customer Name").Item(1)
    If oCC.ShowingPlaceholderText Then
        MsgBox "Complete the Customer Name!"
        oCC.Range.Select
        GoTo lbl_Exit
    Else
        strName = oCC.Range.Text
    End If

    strFilename = strPlate & "_" & strName & ".docx"
    ActiveDocument.SaveAs2 FileName:=strFilename, FileFormat:=12
lbl_Exit:
    Set oCC = Nothing
    Exit Sub
err_Handler:
    MsgBox Err.Number & vbCr & Err.Description
    Err.Clear
    GoTo lbl_Exit
End Sub

[realitydrm]

Thanks for the help! How do I save to a folder besides the Documents folder. I would like to save to a folder on my desk top.

[gmayor]

The following will save to a named folder on the desktop (which it will create if not present) or you could use the browsefor folder function as I suggested earlier, to pick any folder.

Sub SaveExample2()
'Graham Mayor - http://www.gmayor.com - Last updated - 13/03/2017
Dim strPath As String
Dim strPlate As String
Dim strName As String
Dim strFilename As String
Dim oCC As ContentControl

    strPath = Environ("USERPROFILE") & "\Desktop\Documents Folder\"
    CreateFolders strPath
    'Or using the BrowseForFolder function from my web site to pick a folder
    'strPath = BrowseForFolder
    On Error GoTo err_Handler
    Set oCC = ActiveDocument.SelectContentControlsByTitle("License Plate Number").Item(1)
    If oCC.ShowingPlaceholderText Then
        MsgBox "Complete the License plate number!"
        oCC.Range.Select
        GoTo lbl_Exit
    Else
        strPlate = oCC.Range.Text
    End If

    Set oCC = ActiveDocument.SelectContentControlsByTitle("Customer Name").Item(1)
    If oCC.ShowingPlaceholderText Then
        MsgBox "Complete the Customer Name!"
        oCC.Range.Select
        GoTo lbl_Exit
    Else
        strName = oCC.Range.Text
    End If

    strFilename = strPlate & "_" & strName & ".docx"
    ActiveDocument.SaveAs2 FileName:=strPath & strFilename, FileFormat:=12
lbl_Exit:
    Set oCC = Nothing
    Exit Sub
err_Handler:
    MsgBox Err.Number & vbCr & Err.Description
    Err.Clear
    GoTo lbl_Exit
End Sub

Private Sub CreateFolders(strPath As String)
'A Graham Mayor/Greg Maxey AddIn Utility Macro
Dim oFSO As Object
Dim lngPathSep As Long
Dim lngPS As Long
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
    lngPathSep = InStr(3, strPath, "\")
    If lngPathSep = 0 Then GoTo lbl_Exit
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Do
        lngPS = lngPathSep
        lngPathSep = InStr(lngPS + 1, strPath, "\")
        If lngPathSep = 0 Then Exit Do
        If Len(Dir(Left(strPath, lngPathSep), vbDirectory)) = 0 Then Exit Do
    Loop
    Do Until lngPathSep = 0
        If Not oFSO.FolderExists(Left(strPath, lngPathSep)) Then
            oFSO.CreateFolder Left(strPath, lngPathSep)
        End If
        lngPS = lngPathSep
        lngPathSep = InStr(lngPS + 1, strPath, "\")
    Loop
lbl_Exit:
    Set oFSO = Nothing
    Exit Sub
End Sub

[realitydrm]

Thanks a lot for the help! I also added an outlook function and run all. See below.

Sub RunAll()
    Call Save
    
    Call sendeMail
End Sub

Sub Save()

    Dim strPath As String
    Dim strPlate As String
    Dim strName As String
    Dim strFilename As String
    Dim oCC As ContentControl
     
    strPath = "C:\Users\myusername.myusername\Desktop\"
    CreateFolders strPath
    
    On Error GoTo err_Handler
    Set oCC = ActiveDocument.SelectContentControlsByTitle("License Plate Number").Item(1)
    If oCC.ShowingPlaceholderText Then
        MsgBox "Complete the License plate number!"
        oCC.Range.Select
        GoTo lbl_Exit
    Else
        strPlate = oCC.Range.Text
    End If
     
    Set oCC = ActiveDocument.SelectContentControlsByTitle("Customer Name").Item(1)
    If oCC.ShowingPlaceholderText Then
        MsgBox "Complete the Customer Name!"
        oCC.Range.Select
        GoTo lbl_Exit
    Else
        strName = oCC.Range.Text
    End If
     
    strFilename = strPlate & "_" & strName & ".docx"
    ActiveDocument.SaveAs2 FileName:=strPath & strFilename, FileFormat:=12
lbl_Exit:
    Set oCC = Nothing
    Exit Sub
err_Handler:
    MsgBox Err.Number & vbCr & Err.Description
    Err.Clear
    GoTo lbl_Exit
End Sub


Private Sub CreateFolders(strPath As String)
    
    Dim oFSO As Object
    Dim lngPathSep As Long
    Dim lngPS As Long
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
    lngPathSep = InStr(3, strPath, "\")
    If lngPathSep = 0 Then GoTo lbl_Exit
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Do
        lngPS = lngPathSep
        lngPathSep = InStr(lngPS + 1, strPath, "\")
        If lngPathSep = 0 Then Exit Do
        If Len(Dir(Left(strPath, lngPathSep), vbDirectory)) = 0 Then Exit Do
    Loop
    Do Until lngPathSep = 0
        If Not oFSO.FolderExists(Left(strPath, lngPathSep)) Then
            oFSO.CreateFolder Left(strPath, lngPathSep)
        End If
        lngPS = lngPathSep
        lngPathSep = InStr(lngPS + 1, strPath, "\")
    Loop
lbl_Exit:
    Set oFSO = Nothing
    Exit Sub
End Sub

Private Sub sendeMail()
Dim olkApp As Object
Dim strSubject As String
Dim strTo As String
Dim strBody As String
Dim strAtt As String

    strSubject = ""
    strBody = ""
    strTo = ""
    If ActiveDocument.FullName = "" Then
        MsgBox "activedocument not saved, exiting"
        Exit Sub
    Else
        If ActiveDocument.Saved = False Then
            If MsgBox("Activedocument NOT saved, Proceed?", vbYesNo, "Error") <> vbYes Then Exit Sub
        End If
    End If
    strAtt = ActiveDocument.FullName
    
    Set olkApp = CreateObject("outlook.application")
    With olkApp.createitem(0)
        .to = strTo
        .Subject = strSubject
        .body = strBody
        .attachments.Add strAtt
        '.send
        .Display
    End With
    Set olkApp = Nothing
End Sub