VBA help to email a document

[megha]

The following VBA code working perfectly fine in excel. I need help to convert this code for Microsoft word. I'm looking to do the exact same thing to a form built in word. Can someone please help?

Private Sub CommandButton1_Click()
MsgBox "Please make sure your Outlook is open"
    'Working in Excel 2000-2016
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set Sourcewb = ActiveWorkbook
    'Copy the ActiveSheet to a new workbook
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook
    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007-2016
            Select Case Sourcewb.FileFormat
            Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
            Case 52:
                If .HasVBProject Then
                    FileExtStr = ".xlsm": FileFormatNum = 52
                Else
                    FileExtStr = ".xlsx": FileFormatNum = 51
                End If
            Case 56: FileExtStr = ".xls": FileFormatNum = 56
            Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
            End Select
        End If
    End With
    '    'Change all cells in the worksheet to values if you want
    '    With Destwb.Sheets(1).UsedRange
    '        .Cells.Copy
    '        .Cells.PasteSpecial xlPasteValues
    '        .Cells(1).Select
    '    End With
    '    Application.CutCopyMode = False
    'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "" & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .to = "***x@gmail.com"
            .CC = ""
            .BCC = ""
            .Subject = "Waste Collection Request Form"
            .Body = ""
            .Attachments.Add Destwb.FullName
            'You can add other files also like this
            '.Attachments.Add ("C:\test.txt")
            .Send   'or use .Display
        End With
        On Error GoTo 0
        .Close savechanges:=False
    End With
    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr
    Set OutMail = Nothing
    Set OutApp = Nothing
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    MsgBox "Your form has been emailed. Please check your sent item for a copy"
    ThisWorkbook.Close savechanges:=False
End Sub

[megha]

can anyone please help me with this?

[macropod]

A little patience might not go astray; it was 4:39am here when you posted. Guess what I was doing then???

As for 'Can someone please help' you might start by saying what you're trying to achieve. After all, a Word document's structure is entirely different to an Excel workbook's structure.

[megha]

I have a form in word. I'm looking for a macro that can do followings:

1) whenever the user complete the form he/she can email it as an attachment by clicking a macro button
2) the original form always remain blank so next user can fill it and email it as an attachment by clicking the button

The code in my first post does all this but that code in built for excel and working fine in excel. i'm looking do same thing in word.

Thank you!

[macropod]

A little time searching previous discussions on your topic wouldn't go astray. See, for example: http://www.vbaexpress.com/forum/show...document+email

[megha]

Ok this is what i came up with but i'm getting error message "RUN TIME ERROR 424 - OBJECT REQUIRED" and when i hit debug it highlight this item in my code:

TempFileName = "" & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

Can someone please help me to fix this? Here is my entire code:

Private Sub CommandButton21_Click()
Dim OL              As Object
Dim EmailItem       As Object
Dim Doc             As Document
Dim TempFilePath As String
    
Dim TempFileName As String
 
Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Doc = ActiveDocument
TempFilePath = Environ$("temp") & "\"
    
TempFileName = "" & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
Doc.SaveAs2 TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
 
With EmailItem
    .Subject = "P66 Bayway Refinery Waste Collection Request Form"
    .Body = "Please see attached form"
    .To = ***@gmail.com
    
    '.cc = ""
    '.Importance = olImportanceNormal 'Or olImprotanceHigh Or olImprotanceLow
    .Attachments.Add Doc.FullName
    .Send
End With
 
Application.ScreenUpdating = True
 
Set Doc = Nothing
Set OL = Nothing
Set EmailItem = Nothing
MsgBox "Your form has been emailed. Please check your sent item for a copy"
ThisDocument.Close SaveChanges:=False
     
End Sub

[megha]

I was able to resolved error 424. I am now using the following code but the kill statement is not working. It say "file not found" everything else works fine.

Private Sub CommandButton21_Click()
    Dim OL              As Object
    Dim EmailItem       As Object
    Dim Doc             As Document
    Dim TempFilePath As String
    Dim TempFileName As String
     
    Application.ScreenUpdating = False
    Set OL = CreateObject("Outlook.Application")
    Set EmailItem = OL.CreateItem(olMailItem)
    Set Doc = ActiveDocument
    TempFilePath = Environ$("temp") & "\"
     
    TempFileName = "" & " " & Format(Now, "dd-mmm-yy h-mm-ss")
    Doc.SaveAs2 TempFilePath & TempFileName
     
    With EmailItem
        .Subject = ""
        .Body = "Please see attached form"
        .To = ***@gmail.com
         
         '.cc = ""
         '.Importance = olImportanceNormal 'Or olImprotanceHigh Or olImprotanceLow
        .Attachments.Add Doc.FullName
        .Send
    End With
     
    Application.ScreenUpdating = True
    
    Kill TempFilePath & TempFileName
     
    Set Doc = Nothing
    Set OL = Nothing
    Set EmailItem = Nothing
    MsgBox "Your form has been emailed. Please check your sent item for a copy"
    ThisDocument.Close SaveChanges:=False
     
End Sub