Making a Command Button that Prints, Saves and Emails

rmw85 · #1 05-02-2012, 06:25 AM

I'm extremly new to Visual Basic, all i know is what i've been picking up online in the past few month. I'm working on a template in word that Prints the document, Saves it then emails it to just one email. I had the code to a point where it worked perfectly on my machine aslong as you didnt click No in any of the message boxes. When you put the document on the network drives the Command Button no longer works even when enabling Macros and such. So then when brainstorming it will probably be easier to put it on our webpage for people to access then the network drive as that can be confusing to some users. The problem i ran across there is that when you open from the website it created opens the document as Read-Only and the code no longer Saves or Emails as i wanted it to but does print fine. I found a code that i've tried that makes it into a temp document and saves but loses formatting and doesnt email as the document thats open stays the same.

If you can point me in the right direction or have suggestions please let me know. Been working on this for abit now and would like some input.

EDIT: I should also add maybe the important part. The reason i created the temp file was because the first line of the document is what i want it saved as and the Subject line of the email and when opened as read-only it just keeps that name and doesnt allow it to change. When the template was opened Word by default wants to save the document as whatever is in the first line of the document which is EXACTLY what i'm looking for.
Thanks.

Code:

Private Sub CommandButton1_Click()
    'Save, Print and email documents
    Dim noSession As Object, noDatabase As Object, noDocument As Object
    Dim obAttachment As Object, EmbedObject As Object
    Dim stSubject As Variant, stAttachment As String
    Dim vaRecipient As Variant
    
    'Print Document
    Shapes(1).Visible = msoFalse
    ActiveDocument.PrintOut Background:=False
    Shapes(1).Visible = msoTrue
    
    'Check if the active Document is saved or not
    Const EMBED_ATTACHMENT As Long = 1454
    Const stTitle As String = "Active Document status"
    Const stMsg As String = "The active Document must first be saved " & vbCrLf _
    & "before it can be sent as an attachment."
    
    'If the active Document has not been saved at all.
    If Len(ActiveDocument.Path) = 0 Then
        MsgBox stMsg, vbInformation, stTitle
    End If
    
    'Ask then create folder if not created
     Dim rspCreate
    If Dir("E:\Documents and Settings\" & Environ("username") & "\Desktop\EMS\", vbDirectory) = "" Then
       rspCreate = MsgBox("Directory doesn't exist, do you wish to create it?", vbYesNo)
      If rspCreate = vbYes Then
            MkDir "E:\Documents and Settings\" & Environ("username") & "\Desktop\EMS\"
        End If
    End If
    
    'If the changes in the active Document have been saved or not.
    If ActiveDocument.Saved = False Then
        ChangeFileOpenDirectory "E:\Documents and Settings\" & Environ("username") & "\Desktop\EMS\"
        ActiveDocument.Save
    End If
    
     'Email address where file is sent to.
    vaRecipient = "myemail@mycompany.com"
     'Get the message from the user.
    stAttachment = ActiveDocument.FullName
     'Instantiate the Lotus Notes COM's Objects.
    Set noSession = CreateObject("Notes.NotesSession")
    Set noDatabase = noSession.GETDATABASE("", "")
     'If Lotus Notes is not open then open the mail-part of it.
    If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
     'Create the e-mail and the attachment.
    Set noDocument = noDatabase.CreateDocument
    Set obAttachment = noDocument.CreateRichTextItem("stAttachment")
    Set EmbedObject = obAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)
    
     'Add values to the created e-mail main properties.
    With noDocument
        .Form = "Memo"
        .SendTo = vaRecipient
        .Subject = ActiveDocument.Name
        .Body = "Attached in this email is the EMS forum"
        .SaveMessageOnSend = True
    End With
    
     'Send the e-mail instantly.
    With noDocument
        .PostedDate = Now()
        .Send 0, vaRecipient
    End With
   
    'End message to users saying process was sucessful
    MsgBox "Document was emailed and printed sucessfully"
    'Release objects from the memory.
    Set EmbedObject = Nothing
    Set obAttachment = Nothing
    Set noDocument = Nothing
    Set noDatabase = Nothing
    Set noSession = Nothing

End Sub

The code i was using for the temp file is

Code:

Private Sub CommandButton1_Click()
    Dim oSection As Section
    Dim r As Range
    Dim TempDoc As Document
    Dim FirstPara As String
     
    For Each oSection In ActiveDocument.Sections
        Set r = oSection.Range
        r.End = r.End - 1
        Set TempDoc = Documents.Add
        With TempDoc
            .Range = r
            FirstPara = r.Paragraphs(1).Range.Text
            FirstPara = Left(FirstPara, Len(FirstPara) - 1)
            ChangeFileOpenDirectory "E:\Documents and Settings\" & Environ("username") & "\Desktop\EMS\"
            .SaveAs FileName:=FirstPara & ".docx"
            .Close
        End With
        Set r = Nothing
        Set TempDoc = Nothing
    Next
End Sub

rmw85 · #2 05-02-2012, 12:43 PM

After pluggin away at this for some time i maybe onto something. In the code that creates the TempDoc there is a line

Code:

 
FirstPara = r.Paragraphs(1).Range.Text

The problem is it only grabs the text. The document has tables and other formatting that isnt pulled. Not sure what i need todo to change that but i think that might be where i'm stuck at. Once i get that figured out i think i can add the original code before closing out the Tempdoc and be golden. Any help on what i should use would be greatly appreciated.
Randy

macropod · #3 05-02-2012, 05:48 PM

hi rwm,

Let's start with the basics:

Quote:

I'm working on a template in word that Prints the document

Please be clear with the terms you're using. In Word parlance, templates and documents are quite different. Are you creating a template, or a document? Your subsequent comments suggest the latter.

Quote:

When you put the document on the network drives the Command Button no longer works even when enabling Macros and such.

Are you sure all your code and userform are all in the file you're using as the template, and not in, say, your 'Normal' template? Does the useform and command button appear?

I also note that you have posted two subs named 'CommandButton1_Click'. You can't have two such subs attached to the one userform. So, how many userforms are we dealing with and on which ones don't the command buttons work? Do you get any error messages? If so, what do they say and what, if any, line is highlighted when you enter the debug mode? Have you added some code to the command button subs to test where they're failing? You could, for example, use something as simple as 'MsgBox "!"' to confirm that the code runs to a certain point.

Re:

Quote:

The problem i ran across there is that when you open from the website it created opens the document as Read-Only and the code no longer Saves or Emails as i wanted it to but does print fine.

Obviously you can't save to a read-only location. This also suggests you're providing a document, not a template.

Re:

Quote:

The reason i created the temp file was because the first line of the document is what i want it saved as and the Subject line of the email and when opened as read-only it just keeps that name and doesnt allow it to change. When the template was opened Word by default wants to save the document as whatever is in the first line of the document which is EXACTLY what i'm looking for.

Unless you're emailing the temp document, this shouldn't be necessary. You can simply retrieve the first paragraph/line's text and use that as the email subject. I imagine Lotus Notes has a parameter for inserting subject names via code, but I'm not familiar with its object model.

You say "it worked perfectly on my machine aslong as you didnt click No in any of the message boxes". Obviously, you'll need to fix that. I note, for example, that you have code that asks the user whether a certain folder exists. Even if the user answers no to that prompt, your code then tries to save the file there. It's bound to fall over in that case. You either need to create the folder without asking the user or, if they choose 'no', asking them where to save the filke to and not proceeding until they've nominated a valid destination, to which the file is then saved.

rmw85 · #4 05-03-2012, 06:19 AM

Thanks for the reply.

I'm pretty sure its a template that i am working on as its a .dotm extension.

The reason for the two command codes is because i tried the one it worked great but doesnt when its opened of the website as READ ONLY so i cut that code and pasted it somewhere else and used a new code to try and figure out how to get the document out of the read only but havent had much luck with the smaller second code.

Quote:

Are you sure all your code and userform are all in the file you're using as the template, and not in, say, your 'Normal' template? Does the useform and command button appear?

The userform and button do show up and i don't have them

Quote:

Unless you're emailing the temp document, this shouldn't be necessary.

Once its filled in the finished document does get emailed and and i'm trying to save it aswell under the name. The first line is the customer name and number and thats what its being saved as and the heading of the email is.

Quote:

You say "it worked perfectly on my machine aslong as you didnt click No in any of the message boxes". Obviously, you'll need to fix that. I note, for example, that you have code that asks the user whether a certain folder exists. Even if the user answers no to that prompt, your code then tries to save the file there. It's bound to fall over in that case. You either need to create the folder without asking the user or, if they choose 'no', asking them where to save the filke to and not proceeding until they've nominated a valid destination, to which the file is then saved.

At this point the not exiting the code properly when clicking as of now might just be the way it is. They are going to have to copy to that location anyway and most of the code is copied and pasted from code i found online and then tweaked to work properly when clicked yes. I tried having the code just run anyway but was getting errors so as of now it is what it is and the users will have to click ok anyway. More of a workaround then a fix for now.

I know the basics of word but once i get further into detail with macro's and Visual Basic i'm basically teaching myself as i'm building this document.

Thanks,
Randy

Here is some code i got to come close to what i'm attempting. The formatting is still alittle messed up as in the margins and spacing but it shows the tables in there. I put a note in there which is just a place holder to when i figured out how to acheived what i'm looking for then i was going to add the first code (the longer one) and piece that into there and it should in theory work the way i'd like it to.

Code:

Private Sub CommandButton1_Click()
    Dim oSection As Section
    Dim r As Range
    Dim TempDoc As Document
    Dim FirstPara As String
 
    For Each oSection In ActiveDocument.Sections
        Set r = oSection.Range
        r.End = r.End - 1
        Set TempDoc = Documents.Add
        With TempDoc
            ActiveDocument.Paragraphs(1).Range.FormattedText = r
            FirstPara = r.Paragraphs(1).Range.FormattedText
            FirstPara = Left(FirstPara, Len(FirstPara) - 1)
            ChangeFileOpenDirectory "E:\Documents and Settings\" & Environ("username") & "\Desktop\EMS\"
            .SaveAs FileName:=FirstPara & ".docx"
    'Dont have this close yet make it print then email and close
            .Close
        End With
        Set r = Nothing
        Set TempDoc = Nothing
    Next
End Sub

macropod · #5 05-04-2012, 12:17 AM

Hi Randy,

OK, if the useform & command button show, the code behind them should be there also. In that case, try adding something like:
MsgBox "!"
at different points in the code so that you can see where is runs to.

Instead of your latest sub, try:

Code:

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim Scn As Section, Rng As Range, Doc As Document
Dim StrPath As String, StrName As String
StrPath = "E:\Documents and Settings\" & Environ("UserName") & "\Desktop\EMS\"
If Dir(StrPath, vbDirectory) = "" Then
  MkDir StrPath
End If
For Each Scn In ActiveDocument.Sections
  Set Rng = Scn.Range
  With Rng
    .End = .End - 1
    .Copy
  End With
  Set Doc = Documents.Add
  With Doc
    .Range.Paste
    Set Rng = .Range.Paragraphs.First
    With Rng
      .End = .End - 1
      StrName = .Text
    End With
    .SaveAs FileName:=StrPath & StrName & ".docx", AddToRecentFiles:=False
    .Close
  End With
Next
Set Rng = Nothing: Set Doc = Nothing
Application.ScreenUpdating = True
End Sub

This should save each Section in your active document as a new file in the target folder, which will be created if it doesn't already exist.

rmw85 · #6 05-04-2012, 09:52 AM

Thanks Paul. I tried the code out but was getting some errors when trying to run it.

I was messing around with the code below some more and added the other line of code to it to make it the ALL IN ONE that i'm going for. I'm having problems with the email part now. It stops at this line
Set EmbedObject = obAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)
but i'm getting close with the code i have posted below

Thanks very much for the suggestion. I'm still open up to some and even putting code together to make this work. Thats all the code i have no is pieced together and tweaked here and there.

Thanks,
Randy

Code:

Private Sub CommandButton1_Click()
    Dim oSection As Section
    Dim r As Range
    Dim TempDoc As Document
    Dim FirstPara As String
    
    'Print Document
    Shapes(1).Visible = msoFalse
    ActiveDocument.PrintOut Background:=False
    Shapes(1).Visible = msoTrue
     
    'Change Readonly Doc to a Temp Document
    For Each oSection In ActiveDocument.Sections
        Set r = oSection.Range
        r.End = r.End - 1
        Set TempDoc = Documents.Add
    With TempDoc
    
    'Change Temp Documents Page Layout to match Original
    With Selection.PageSetup
        .LineNumbering.Active = False
        .Orientation = wdOrientPortrait
        .TopMargin = InchesToPoints(0.5)
        .BottomMargin = InchesToPoints(0.5)
        .LeftMargin = InchesToPoints(0.5)
        .RightMargin = InchesToPoints(0.5)
        .Gutter = InchesToPoints(0)
        .HeaderDistance = InchesToPoints(0.5)
        .FooterDistance = InchesToPoints(0.5)
        .PageWidth = InchesToPoints(8.5)
        .PageHeight = InchesToPoints(11)
        .FirstPageTray = wdPrinterDefaultBin
        .OtherPagesTray = wdPrinterDefaultBin
        .SectionStart = wdSectionNewPage
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .VerticalAlignment = wdAlignVerticalTop
        .SuppressEndnotes = False
        .MirrorMargins = False
        .TwoPagesOnOne = False
        .BookFoldPrinting = False
        .BookFoldRevPrinting = False
        .BookFoldPrintingSheets = 1
        .GutterPos = wdGutterPosLeft
    End With
    
    'Ask then create folder if not created
    Dim rspCreate
    If Dir("E:\Documents and Settings\" & Environ("username") & "\Desktop\EMS\", vbDirectory) = "" Then
      rspCreate = MsgBox("Directory doesn't exist, do you wish to create it?", vbYesNo)
        If rspCreate = vbYes Then
            MkDir "E:\Documents and Settings\" & Environ("username") & "\Desktop\EMS\"
        End If
    End If
      
      'Set it so that the first paragraph is the name of document
            ActiveDocument.Paragraphs(1).Range.FormattedText = r
            FirstPara = r.Paragraphs(1).Range.FormattedText
            FirstPara = Left(FirstPara, Len(FirstPara) - 1)
            
      'save document
            ChangeFileOpenDirectory "E:\Documents and Settings\" & Environ("username") & "\Desktop\EMS\"
            .SaveAs FileName:=FirstPara & ".docx"
    'Print and email documents
    Dim noSession As Object, noDatabase As Object, noDocument As Object
    Dim obAttachment As Object, EmbedObject As Object
    Dim stSubject As Variant, stAttachment As String
    Dim vaRecipient As Variant
   
     'Email address where file is sent to.
    vaRecipient = "email@myemail.com"
     'Get the message from the user.
    stAttachment = ActiveDocument.FullName
     'Instantiate the Lotus Notes COM's Objects.
    Set noSession = CreateObject("Notes.NotesSession")
    Set noDatabase = noSession.GETDATABASE("", "")
     'If Lotus Notes is not open then open the mail-part of it.
    If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
     'Create the e-mail and the attachment.
    Set noDocument = noDatabase.CreateDocument
    Set obAttachment = noDocument.CreateRichTextItem("stAttachment")
    Set EmbedObject = obAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)
    
     'Add values to the created e-mail main properties.
    With noDocument
        .Form = "Memo"
        .SendTo = vaRecipient
        .Subject = ActiveDocument.Name
        .Body = "Attached in this email is the EMS forum"
        .SaveMessageOnSend = True
    End With
    
     'Send the e-mail instantly.
    With noDocument
        .PostedDate = Now()
        .Send 0, vaRecipient
    End With
   
    'End message to users saying process was sucessful
    MsgBox "Document was emailed and printed sucessfully"
    'Release objects from the memory.
    Set EmbedObject = Nothing
    Set obAttachment = Nothing
    Set noDocument = Nothing
    Set noDatabase = Nothing
    Set noSession = Nothing
    
    
    .Close
    
    End With
        Set r = Nothing
        Set TempDoc = Nothing
    Next
End Sub

rmw85 · #7 05-04-2012, 12:12 PM

Just to let you know I get the error

Runtime error '13":
type mismatch

This is highlighted in yellow
Set Rng = .Range.Paragraphs.First

rmw85 · #8 05-09-2012, 07:58 AM

Well for the bulk of the code the issue is solved. Thanks for the help and suggestions. Been throwing everything at it i can find and came up with this code below. Its not 100% as if you click no or cancel it will error out on you but if someone else is looking for code like this i atleast got a good portion figured out for someone to mess with for their own.

Code:

Private Sub CommandButton1_Click()
    Dim oSection As Section
    Dim r As Range
    Dim TempDoc As Document
    Dim FirstPara As String
    
    'Print Document
    Shapes(1).Visible = msoFalse
    ActiveDocument.PrintOut Background:=False
    Shapes(1).Visible = msoTrue
     
    'Change Readonly Doc to a Temp Document
    For Each oSection In ActiveDocument.Sections
        Set r = oSection.Range
        r.End = r.End - 1
        Set TempDoc = Documents.Add
    With TempDoc
    
    'Change Temp Documents Page Layout to match Original
    With Selection.PageSetup
        .LineNumbering.Active = False
        .Orientation = wdOrientPortrait
        .TopMargin = InchesToPoints(0.5)
        .BottomMargin = InchesToPoints(0.5)
        .LeftMargin = InchesToPoints(0.5)
        .RightMargin = InchesToPoints(0.5)
        .Gutter = InchesToPoints(0)
        .HeaderDistance = InchesToPoints(0.5)
        .FooterDistance = InchesToPoints(0.5)
        .PageWidth = InchesToPoints(8.5)
        .PageHeight = InchesToPoints(11)
        .FirstPageTray = wdPrinterDefaultBin
        .OtherPagesTray = wdPrinterDefaultBin
        .SectionStart = wdSectionNewPage
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .VerticalAlignment = wdAlignVerticalTop
        .SuppressEndnotes = False
        .MirrorMargins = False
        .TwoPagesOnOne = False
        .BookFoldPrinting = False
        .BookFoldRevPrinting = False
        .BookFoldPrintingSheets = 1
        .GutterPos = wdGutterPosLeft
    End With
    
    'Ask then create folder if not created
    Dim rspCreate
    If Dir("E:\Documents and Settings\" & Environ("username") & "\Desktop\EMS\", vbDirectory) = "" Then
      rspCreate = MsgBox("Directory doesn't exist, do you wish to create it?", vbYesNo)
        If rspCreate = vbYes Then
            MkDir "E:\Documents and Settings\" & Environ("username") & "\Desktop\EMS\"
        End If
    End If
      
      'Set it so that the first paragraph is the name of document
            ActiveDocument.Paragraphs(1).Range.FormattedText = r
            FirstPara = r.Paragraphs(1).Range.FormattedText
            FirstPara = Left(FirstPara, Len(FirstPara) - 1)
            
      'save document
            ChangeFileOpenDirectory "E:\Documents and Settings\" & Environ("username") & "\Desktop\EMS\"
            .SaveAs FileName:=FirstPara & ".docx"
    'Print and email documents
    Dim noSession As Object, noDatabase As Object, noDocument As Object
    Dim obAttachment As Object, EmbedObject As Object
    Dim stSubject As Variant, stAttachment As String
    Dim vaRecipient As Variant
   
     'Email address where file is sent to.
    vaRecipient = email@myemaildomain.com
     'Get the message from the user.
    stAttachment = ActiveDocument.FullName
     'Instantiate the Lotus Notes COM's Objects.
    Set noSession = CreateObject("Notes.NotesSession")
    Set noDatabase = noSession.GETDATABASE("", "")
     'If Lotus Notes is not open then open the mail-part of it.
    If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
     'Create the e-mail and the attachment.
    Set noDocument = noDatabase.CreateDocument
    Set obAttachment = noDocument.CreateRichTextItem("stAttachment")
    Set EmbedObject = obAttachment.EmbedObject(1454, "", stAttachment)
    
     'Add values to the created e-mail main properties.
    With noDocument
        .Form = "Memo"
        .SendTo = vaRecipient
        .Subject = ActiveDocument.Name
        .Body = "Attached in this email is the EMS forum"
        .SaveMessageOnSend = True
    End With
    
     'Send the e-mail instantly.
    With noDocument
        .PostedDate = Now()
        .Send 0, vaRecipient
    End With
   
    'End message to users saying process was sucessful
    MsgBox "Document was emailed and printed sucessfully"
    'Release objects from the memory.
    Set EmbedObject = Nothing
    Set obAttachment = Nothing
    Set noDocument = Nothing
    Set noDatabase = Nothing
    Set noSession = Nothing
    
    
    .Close
    
    End With
        Set r = Nothing
        Set TempDoc = Nothing
    Next
End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Command Button doesnt work on network	rmw85	Word VBA	1	04-25-2012 01:02 PM
VBA Print Command Prints Document Twice	HorizonSC	Word	2	11-15-2011 03:26 AM
Check Boxes and Command Buttons	Micky P	Word VBA	0	10-27-2011 01:06 AM
Command Button	cksm4	Word VBA	7	02-27-2011 08:47 PM
Making a button to open an Access Dbase	aubreylc	Outlook	2	04-07-2010 12:53 PM