create file name using values from content control fields, then save and send file as attachment

ShellR · #1 08-08-2024, 09:43 AM

Hello, I am trying to figure out how to use the 1st 4 characters of a content control I bookmarked as FirstName + the 1st 4 characters of a content control I bookmarked as LastName + last 4 characters of a content control I bookmarked as PhoneH (would need to check to see if it's empty first); else would use the last 4 characters of a content control I bookmarked as PhoneC (would also need to check to see if it's empty); else would use the last 4 characters of a content control I bookmarked as PhoneO + date (yymmdd) from a field I added via the Insert>Date&Time (format: yyyy-MM-dd h:mm:ss am/pm).
I would like to use those values to create the filename, which I would then save (as is (word document), or perhaps a pdf), and then send as an attachment through (Outlook (ideally). But, since I don't currently have outlook on my desktop; is there a way to send it through another mail server perhaps?

thank you

Guessed · #2 08-08-2024, 04:47 PM

You've got quite a bit going on here so lets break it down in smaller chunks.

Firstly, we don't normally use bookmarks to define content controls, instead it is preferable to use the CC title or tag property.
If you use the Title Property for FirstName and LastName, can you get this stage one part of the macro going?

Code:

Sub GetFileName()
  Dim str As String, aCC As ContentControl
  str = Left(ActiveDocument.SelectContentControlsByTitle("Name")(1).Range.Text, 4)
  str = str & Left(ActiveDocument.SelectContentControlsByTitle("Lastname")(1).Range.Text, 4)
  Set aCC = ActiveDocument.SelectContentControlsByTitle("PhoneH")(1)
  If aCC.ShowingPlaceholderText Then
    'need code to check PhoneC here
  Else
    str = str & Right(aCC.Range.Text, 4)
  End If
  MsgBox str
End Sub

ShellR · #3 08-08-2024, 05:10 PM

Hello, thank you so much for your response.

While waiting for a response, I tried the following code:

Sub GetFileName()

strFName = ActiveDocument.SelectContentControlsByTitle("First Name")(1).Range.Text
strLName = ActiveDocument.SelectContentControlsByTitle("LastN ame")(1).Range.Text
strPhoneC = ActiveDocument.SelectContentControlsByTitle("Phone C")(1).Range.Text)

Dim strFilename As String
strFilename = strFName & "_" & strLName & "_" & strPhoneC & ".pdf"
ActiveDocument.SaveAs2 strFilename, FileFormat:=wdFormatPDF
MsgBox "Document saved", vbInformation
End Sub

it worked somewhat. Looked like it saved the file etc. However, I couldn't remember the syntax to get only a portion of the field value. So, thank you so much.
I've used your code and, it works perfectly.
Now, I want to also include an underscore with the date to the filename. However, the date is not contained in a content control; it's in a text box (i'm guessing) which I added by using the INSERT>Date&Time option. So, I am clueless as to how to get that info. Unless I can simply use the date the file was saved?

gmayor · #4 08-09-2024, 07:03 AM

If the date is today's date then simply insert the date as below. If it is a different date, then replace the date in the document with a date content control - see Insert Content Control Add-In

I recommend checking for illegal filename characters and also declaring a path. The following will do both and create the named path if missing.

It is good practice to declare all used variable names. Option Explicit at the top of the module will require you to do so.

Code:

Option Explicit

Sub SaveAsPDF()
Dim strFileName As String
Dim strFName As String
Dim strLName As String
Dim strPhoneC As String
Dim strDate As String
Dim strPath As String

    strPath = "C:\Path\"
    CreateFolders strPath
    strFName = ActiveDocument.SelectContentControlsByTitle("First Name")(1).Range.Text
    strLName = ActiveDocument.SelectContentControlsByTitle("Last Name")(1).Range.Text
    strPhoneC = ActiveDocument.SelectContentControlsByTitle("Phone C")(1).Range.Text
    strDate = Format(Date, "yyyymmdd")
    strFileName = strDate & "_" & strFName & "_" & strLName & "_" & strPhoneC & ".pdf"
    strFileName = strPath & CleanFilename(strFileName)
    ActiveDocument.SaveAs2 strFileName, FileFormat:=wdFormatPDF
    MsgBox "Document saved as" & vbCr & strFileName, vbInformation
lbl_Exit:
    Exit Sub
End Sub
    
Private Function CleanFilename(strFileName As String) As String
Dim arrInvalid() As String
Dim lng_Index As Long
    'Define illegal characters (by ASCII CharNum)
    arrInvalid = Split("9|10|11|13|34|42|47|58|60|62|63|92|124", "|")
    'Remove any illegal filename characters
    CleanFilename = strFileName
    For lng_Index = 0 To UBound(arrInvalid)
        CleanFilename = Replace(CleanFilename, Chr(arrInvalid(lng_Index)), Chr(95))
    Next lng_Index
lbl_Exit:
    Exit Function
End Function

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

ShellR · #5 08-09-2024, 08:06 AM

Thank you for your response.
I do have a couple of questions:
for the following code lines:
strFileName = strPath & CleanFilename(strFileName)
ActiveDocument.SaveAs2 strFileName, FileFormat:=wdFormatPDF

If I understand correctly, once the folder has been created and the file name is created, the file is then saved in that path.
would I then use the strFileName (replacing Doc.FullName with strFileName) in the code below to then send via email using CDO?

****' .AddAttachment (strFileName)
****' .Send
Also, any idea why I would keep getting a transport error code 0x80040217?

thank you

gmayor · #6 08-09-2024, 09:35 AM

Didn't you say that you don't have Outlook? You can't use Outlook related code if you don't have Outlook. See Andrew's reply to your other post. Otherwise you can add strFilename as an attachment, in the same macro, or in a sub called from that macro.

ShellR · #7 08-09-2024, 12:50 PM

I don't have outlook.
this is the code I tested prior to the code you sent me:
Dim sender_email, email_message, email_message2, reply_address, sender_name As String
Dim Mail As New Message
Dim Cfg As Configuration

On Error GoTo Error_Handling

Set Cfg = Mail.Configuration

'SETUP MAIL CONFIGURATION FIELDS
Cfg(cdoSendUsingMethod) = cdoSendUsingPort
Cfg(cdoSMTPServer) = "SMTP.gmail.com"
Cfg(cdoSMTPServerPort) = 465
Cfg(cdoSMTPAuthenticate) = cdoBasic
Cfg(cdoSMTPUseSSL) = True
Cfg(cdoSendUserName) = "vbatestingtest@gmail.com"
Cfg(cdoSendPassword) = "coding123$$"
Cfg.Fields.Update

'SEND EMAIL
With Mail
.From = "vbatestingtest@gmail.com"
.ReplyTo = "vbatestingtest@gmail.com"
.To = "shellreid2004@yahoo.ca"
.CC = "disegnifenice@gmail.com"
.BCC = " "
.Subject = "testing form send"
.HTMLBody = "testing"
.AddAttachment (strFileB)
' .AddAttachment (strFileD)
.Send
End With
Error_Handling:
If Err.Description <> "" Then MsgBox Err.Description
End Sub

gmayor · #8 08-10-2024, 12:51 AM

Leaving aside the fact that the macro, as written, doesn't know what strFileB refers to, and you should comment out or delete the BCC line if you are not using it, the error suggests that the settings for your SMTP server are not correct. I added the Microsoft CDO for Windows 2000 Library reference, substituted my own server details and a recipient address that I have access to and the message was sent.

This is not a method I am familiar with and, given your stated intention, I am not sure how it will work to be supplied to third parties, but the method can work on a personal level.

ShellR · #9 08-11-2024, 05:04 AM

hmmm. ok. so, I will declare the string variables, comment out BCC, and, find the correct SMTP settings for gmail. The reason I used the CDO option is because I don't have outlook. I wanted to make certain I have the proper code to test to ensure what i am doing with the form works. I found a few different codes that uses Outlook. What I am wondering now is this: 1. do you think it's a good idea perhaps to first check to see if the 3rd party has outlook on their pc first, if not check to see what mail server they are using and then use that server to send the attachment?
I assume it would be some sort of IF ELSE statement? what do you think?

ShellR · #10 08-11-2024, 06:26 AM

So, now with the CDO corrections, I keep getting file not found even though the file was created.
do I have to create a sub or function to get and save the file and then a separate function t send the email? or am I missing some sort of refresh or update code to ensure the file has been save before trying to attach and send it?

gmayor · #11 08-11-2024, 07:25 AM

Quote:

Originally Posted by ShellR

Do you think it's a good idea perhaps to first check to see if the 3rd party has outlook on their pc first, if not check to see what mail server they are using and then use that server to send the attachment?
I assume it would be some sort of IF ELSE statement? what do you think?

You could check if the user has Outlook installed e.g. using the following function to read the registry.

Code:

Function IsOutlook() As Boolean
Dim myWS As Object
Dim RegKey As String
Dim Key As String
    Key = "HKEY_LOCAL_MACHINE\SOFTWARE\Clients\Mail\"
    On Error Resume Next
    'access Windows scripting
    Set myWS = CreateObject("WScript.Shell")
    'read key from registry
    RegKey = myWS.RegRead(Key)
    If RegKey = "Microsoft Outlook" Then
        IsOutlook = True
    End If
lbl_Exit:
    Exit Function
End Function

If the result is true you could use the Outlook routine to send the message.
If it is false then what? Your CDO routine is of no use as you will have no idea of the users' email data to apply to the macro. Perhaps it would be preferable to simply enter a link to your e-mail on the form and ask the user to send the completed form to that address. Or maybe you could create a web form and forget about using Word altogether?

Quote:

Originally Posted by ShellR

So, now with the CDO corrections, I keep getting file not found even though the file was created.

As I mentioned in my last post, your code as posted doesn't know what strFileB refers to. How did you indicate to the macro what that variable refers to?
One way to do it is to create a sub using your posted code and call that from the PDF code. After the line

Code:

ActiveDocument.SaveAs2 strFileName, FileFormat:=wdFormatPDF

add a line to call the following macro

Code:

SendAttachment strfilename

Code:

Sub SendAttachment(strFileB As String)
Dim sender_email, email_message, email_message2, reply_address, sender_name As String
Dim Mail As New Message
Dim Cfg As Configuration
    On Error GoTo Error_Handling
    Set Cfg = Mail.Configuration
    'SETUP MAIL CONFIGURATION FIELDS
    Cfg(cdoSendUsingMethod) = cdoSendUsingPort
    Cfg(cdoSMTPServer) = "SMTP.gmail.com"
    Cfg(cdoSMTPServerPort) = 465
    Cfg(cdoSMTPAuthenticate) = cdoBasic
    Cfg(cdoSMTPUseSSL) = True
    Cfg(cdoSendUserName) = "vbatestingtest@gmail.com"
    Cfg(cdoSendPassword) = "coding123$$"
    Cfg.Fields.Update

    'SEND EMAIL
    With Mail
        .From = "vbatestingtest@gmail.com"
        .ReplyTo = "vbatestingtest@gmail.com"
        .To = "shellreid2004@yahoo.ca"
        .CC = "disegnifenice@gmail.com"
        .BCC = ""
        .Subject = "testing form send"
        .HTMLBody = "testing"
        .AddAttachment (strFileB)
        .send
    End With
Error_Handling:
    If Err.Description <> "" Then MsgBox Err.Description
lbl_Exit:
    Exit Sub
End Sub

P.S. When posting code listings, use the Code tags # to format the code.

ShellR · #12 08-11-2024, 08:04 AM

this is the complete code I was testing

Code:

Private Sub Submit_Click()

  Dim test, str, strFName, strdate, strFilename, strFileA, strFileB, strFileC As String, aCC As ContentControl, Doc As Document
  
  strFName = Left(ActiveDocument.SelectContentControlsByTitle("FirstName")(1).Range.Text, 4)
  str = strFName & Left(ActiveDocument.SelectContentControlsByTitle("LastName")(1).Range.Text, 4)
  strdate = Format(Now, "yyyymmddhhm")
  Set aCC = ActiveDocument.SelectContentControlsByTitle("PhoneC")(1)
  
  If aCC.ShowingPlaceholderText Then
    'need code to check PhoneC here
  Else
    str = str & Right(aCC.Range.Text, 4)
    strFilename = str & "_" & strdate
  End If
    
  strFileA = strFilename
  strFileB = "C:\Users\SR\OneDrive\Documents\FormProject2024\Fillable\From scratch\pdf\" & strFileA
  ActiveDocument.SaveAs FileName:=strFileB, Fileformat:=wdFormatPDF, AddToRecentFiles:=False
  
  Dim sender_email, email_message, email_message2, reply_address, sender_name As String
  Dim Mail As New Message
  Dim Cfg As Configuration
  
    On Error GoTo Error_Handling

    Set Cfg = Mail.Configuration

    'SETUP MAIL CONFIGURATION
    Cfg(cdoSendUsingMethod) = cdoSendUsingPort
    Cfg(cdoSMTPServer) = "smtp.gmail.com"
    Cfg(cdoSMTPServerPort) = 587
    Cfg(cdoSMTPAuthenticate) = cdoBasic
    Cfg(cdoSMTPUseSSL) = True
    Cfg(cdoSendUserName) = "vbatestingtest@gmail.com"
    Cfg(cdoSendPassword) = "coding123$$"
    Cfg.Fields.Update

    'SEND EMAIL
    With Mail
        .From = "vbatestingtest@gmail.com"
        .ReplyTo = "vbatestingtest@gmail.com"
        .To = "shellreid2004@yahoo.ca"
        .CC = "disegnifenice@gmail.com"
        .BCC = " "
        .Subject = "testing form send"
        .HTMLBody = "testing"
        .AddAttachment (strFileB)
         .Send
    End With
Error_Handling:
    If Err.Description <> "" Then MsgBox Err.Description
    
End Sub

ShellR · #13 08-11-2024, 08:10 AM

strFileB was defined as String.
the file was saved. I was able to see it. However, I kept getting a file not found error.

ShellR · #14 08-11-2024, 08:18 AM

I'm curious, using the same idea of checking the user's system to see if outlook is installed, is there a way to simply check what their default email server is and then use that?...I'm thinking though, that if it's possible, the code would have to limit the servers it wants to use or the number of servers it wants to check for(don't want to have to find the smtp details for hundreds of email servers)
I DO like your idea to "simply enter a link to your e-mail on the form and ask the user to send the completed form to that address"
how do I do that? I currently have a submit button on the form for the user to send it once completed

ShellR · #15 08-11-2024, 08:23 AM

Would creating a webform be much simpler than using the word form??

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Save File with specific name from fields input.	PM1	Word	17	10-04-2020 07:22 PM
Save a .docm file as .pdf and email .pdf as attachment	Sydney Lacey	Word VBA	2	02-26-2019 07:04 AM
Macro to check the existence of a word docx file and create a new word file with specific content.	staicumihai	Word VBA	14	11-15-2016 01:42 AM
Create content control for clip art not a picture from file...	swissmiss	Drawing and Graphics	3	11-01-2013 05:43 PM
Save/Send to file	Dawn1231a	Outlook	1	08-05-2010 01:10 PM