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.