Open excel from Word and word file path+file to excel.

[guest00x]

Hello,

I am a newbie at vba and i would like your help.
I have this doc file locked from editing with currently has a macro to email(i am able to add codes to it). I would like to add a code to open an excel and send current word file path and file name to excel when click on button "SEND FORM". With the excel file, it open THAT doc file (each doc file will have same date template but different file name/path base on client name or date so i cannot use static path) and extract data from that doc to excel.
Right now i would like to know how i can have word open excel and send file path to excel. i would try to code the excel after. Thanks in advanced.

Example. c:\user\02-16-17\word.doc (vba to open excel_extract.xls when click on button "SEND FORM")
c:\template\excel_extract.xls (vba to THAT word doc that was just close, the path and name will different for each file)

Note: the doc file has legacy "text form field" that is locked from have bookmark.

Current code --START--

Private Sub cmdSend1_Click()


Dim PauseTime, Start


Options.SendMailAttach = True
With ActiveDocument
.SendMail

PauseTime = 3
Start = Timer

Do While Timer < Start + PauseTime
DoEvents
Loop

SendKeys "email address", True
End With


End Sub

--END--

[gmayor]

It is fairly straightforward to add code to your macro to open a workbook and write the document path to the next available row (here in Column A).

Private Sub cmdSend1_Click()
Dim PauseTime As Long, Start As Long
Dim strPath As String
Dim xlApp As Object
Dim xlBook As Object
Dim NextRow As Long
Dim fso As Object
Const strWorkbook As String = "c:\template\excel_extract.xls"
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FileExists(strWorkbook) Then
        MsgBox "The workbook does not exist." & vbCr & _
               "Create the workbook " & vbCr & strWorkbook & vbCr & "and try again."
        GoTo lbl_Exit
    End If
    Options.SendMailAttach = True
    With ActiveDocument
        .SendMail
        PauseTime = 3
        Start = Timer
        Do While Timer < Start + PauseTime
            DoEvents
        Loop
        SendKeys "email address", True
        strPath = .FullName
    End With
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err Then
        Set xlApp = CreateObject("Excel.Application")
    End If
    On Error GoTo 0
    Set xlBook = xlApp.workbooks.Open(FileName:=strWorkbook)
    xlApp.Visible = True
    NextRow = xlBook.sheets(1).Range("A" & xlBook.sheets(1).Rows.Count).End(-4162).Row + 1
    xlBook.sheets(1).Range("A" & NextRow) = strPath
    xlBook.Save
    xlBook.Close
    xlApp.Quit
lbl_Exit:
    Set fso = Nothing
    Set xlApp = Nothing
    Set xlBook = Nothing
    Exit Sub
End Sub

When the completed forms are returned, http://www.gmayor.com/ExtractDataFromForms.htm might prove useful.

[guest00x]

I thank you for the code. it works great. Is it possible to have email address fixed to "To"? As of now if cursor (type) on body the email address will be entered there.

[gmayor]

Frankly I would use Outlook to create the message. The majority of users that have Word will have Outlook, so why not use it? This will give you far more control over the message. There is of course the inherent difference between Word document and HTML message formats that may need to be accommodated. The following will paste the body of the document to the message body (and preserve the default signature).

The macro calls the Function - OutlookApp() - from Ben Clothier - http://www.rondebruin.nl/win/s1/outlook/openclose.htm - to start Outlook. This is a very useful Function and I strongly recommend it wherever you need to access Outlook from Word or Excel vba.

Option Explicit

Private Sub cmdSend1_Click()
Dim PauseTime As Long, Start As Long
Dim strPath As String
Dim xlApp As Object
Dim xlBook As Object
Dim NextRow As Long
Dim fso As Object
Dim olApp As Object
Dim oItem As Object
Dim olInsp As Object
Dim objDoc As Document
Dim objSel As Range
Dim oRng As Range
Const strWorkbook As String = "c:\template\excel_extract.xls"
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FileExists(strWorkbook) Then
        MsgBox "The workbook does not exist." & vbCr & _
               "Create the workbook " & vbCr & strWorkbook & vbCr & "and try again."
        GoTo lbl_Exit
    End If
    On Error Resume Next
    ActiveDocument.Save
    strPath = ActiveDocument.FullName
    If Len(ActiveDocument.Path) = 0 Then
        MsgBox "The document has not been saved. It must be saved to use this process."
        GoTo lbl_Exit
    End If
    Set oRng = ActiveDocument.Range
    oRng.Copy
    Set olApp = OutlookApp()
    'Create a new mailitem
    Set oItem = olApp.CreateItem(0)
    With oItem
        .BodyFormat = 2
        .Display
        Set objDoc = .GetInspector.WordEditor
        Set objSel = objDoc.Range(0, 0)
        objSel.Paste
        .to = "someone@comewhere.com"
        .Subject = ActiveDocument.Name
        '.send 'Restore after testing
    End With
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err Then
        Set xlApp = CreateObject("Excel.Application")
    End If
    On Error GoTo 0
    Set xlBook = xlApp.Workbooks.Open(FileName:=strWorkbook)
    xlApp.Visible = True
    NextRow = xlBook.Sheets(1).Range("A" & xlBook.Sheets(1).Rows.Count).End(-4162).Row + 1
    xlBook.Sheets(1).Range("A" & NextRow) = strPath
    xlBook.Save
    xlBook.Close
    xlApp.Quit
lbl_Exit:
    Set fso = Nothing
    Set olApp = Nothing
    Set objDoc = Nothing
    Set objSel = Nothing
    Set oRng = Nothing
    Set oItem = Nothing
    Set xlApp = Nothing
    Set xlBook = Nothing
    Exit Sub
End Sub

[guest00x]

I have gotten everything down except that I CAN'T ( as the doc is like a template) the document and send the attachment. With my original code it attaches the activedocument without saving. For the last hour, I have been trying to incorporate that to the new method and yet to find a solution. I guess I will have to save it to temp location and attach. If anyone got solution without saving, please help. thank you.

[gmayor]

The process you used originally does save the document as Document1.docx as the document has to be saved in order to attach it. This begs the question why you are saving the name of the attachment in the workbook. Using the method I suggested, you can save the document in a temporary. If the document is a template, you would be better starting by creating a new document from the template and save it (either separately or as part of this process). You can then write a covering message instead of pasting the body of the message and attach the saved document, and then there would be some point in storing the name of the document in your workbook.

[guest00x]

I have finished what i was asked to do with the help of this forum. I really appreciated to those assisted me with the coding. Thanks.