Extract and use filename with VBA

Hi,
I am currently trying to build a word template that will pull data directly from an excel file and deposit the values in to a table. I have worked out how to do this with some VBA code if I specifically reference the path and file name of the doc which has the data. On clicking a button that I place in the ribbon, the table updates. It works well and achieves my goals.

The issue that I have however is that I want the file to be a template and hence function time after time without any further intervention. Given that the excel file name will be different on each use, the VBA code will immediately error. The word and excel files will however always have the same name and will simply differ by the suffix. Is it therefore possible to code for the following scenario:

word file with table is called ABCDE.doc and will need to pull data from ABCDE.xls or
word file with table is called 12345.doc and will need to pull data from 12345.xls or
word file with table is called asdfg.doc and will need to pull data from asdfg.xls....etc...etc

I am an enthusiastic newbie so please be gentle if you are able to help.

A simple function will give you the matching workbook name - provided it is in the same folder. If not you are going to have to change the macro to use .Name rather than .FullName and tell the macro where to find the workbook.

Code:

---

Function GetWorkbookName(oDoc As Document) As String
Dim strfName As String
    If Len(ActiveDocument.Path) = 0 Then
        GoTo err_Handler
    End If
    strfName = oDoc.FullName
    strfName = Left(strfName, InStrRev(strfName, Chr(46)))
    GetWorkbookName = strfName & "xlsx" 'Use  'xls' if the workbook is in the older format.
lbl_Exit:
    Exit Function
err_Handler:
    GetWorkbookName = ""
    GoTo lbl_Exit
End Function

---

Call the function from your code e.g.

Code:

---

Sub Macro1()
    MsgBox GetWorkbookName(ActiveDocument)
End Sub

---

Thanks graham, the files will always be in the same folder and hence have the same path so I suspect your code will work perfectly. I am travelling on business at the moment and can't immediately try it out but will certainly do so when I am back. Many thanks for your help and such prompt feedback, it is really appreciated. Steve

Hi Graham,

I have done my best to integrate your code into mine but unfortunately I have run out of knowledge. You code works well for identifying the path of the target source file and will return a message box contain said path and the macro is enabled. The difficultly I am have is integrating it in to the code I have written (really stolen from the internet and adapted to my needs!). I have pasted this code below to show what I have so far.

Sub Update_Fields()
Dim objExcel As New Excel.Application
Dim exWb As Excel.Workbook
On Error Resume Next
Set exWb = objExcel.Workbooks.Open("C:\Users\a727174\Desktop\ABCDE.xls")
ActiveDocument.TT.Caption = exWb.Sheets("cost summary").Range("E397").Value

exWb.Saved = True
exWb.Close
On Error GoTo 0
Set exWb = Nothing
End Sub

My approach has been to replace the path to file ABCDE with the getfilename field that your function obtains but this is universally returning errors regardless of how I construct it. I feel as though I am close, but clearly lacking the necessary knowledge to get it right. It would be really appreciated if you could give me some pointers.

Many thanks
Steve

I have no idea from your code what ActiveDocument.TT.Caption is supposed to be, but that aside the following will work.

Code:

---

Option Explicit

Sub Update_Fields()
Dim objExcel As Object
Dim exWb As Object
Dim strPath As String
Dim strCaption As String
Dim bStarted As Boolean

    If Len(ActiveDocument.Path) = 0 Then GoTo lbl_Exit
    On Error Resume Next
    Set objExcel = GetObject(, "Excel.Application")
    If Err Then
        Set objExcel = CreateObject("Excel.Application")
        bStarted = True
    End If
    objExcel.Visible = True        'optional
    On Error GoTo 0
    strPath = GetWorkbookName(ActiveDocument)
    If FileExists(strPath) Then
        Set exWb = objExcel.Workbooks.Open(strPath)
        strCaption = exWb.Sheets("cost summary").Range("E397").Value
        exWb.Close SaveChanges:=False
    Else
        MsgBox "Workbook not available"
    End If

    'do something with strCaption here e.g.
    ActiveDocument.Variables("varCaption").Value = strCaption
    ActiveDocument.Fields.Update
    If bStarted Then objExcel.Quit
lbl_Exit:
    Set objExcel = Nothing
    Set exWb = Nothing
    Exit Sub
End Sub

Private Function GetWorkbookName(oDoc As Document) As String
Dim strfName As String
    If Len(ActiveDocument.Path) = 0 Then
        GoTo err_Handler
    End If
    strfName = oDoc.FullName
    strfName = Left(strfName, InStrRev(strfName, Chr(46)))
    GetWorkbookName = strfName & "xls"
lbl_Exit:
    Exit Function
err_Handler:
    GetWorkbookName = ""
    GoTo lbl_Exit
End Function

Private Function FileExists(strFullName As String) As Boolean
Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FileExists(strFullName) Then
        FileExists = True
    Else
        FileExists = False
    End If
lbl_Exit:
    Exit Function
End Function

---

Thanks Graham. That works absolutely perfectly. I changed strCaption to ActiveDocument.TT.Caption as the caption field in my document which is updated is called TT. With this very minor change everything works. Much of what I am trying to achieve with my documents I am managing to achieve with code on the internet and making the necessary changes. This piece I have struggled with for weeks and even when I look at the solution don't think I would have ever got there.

Thanks again, I really appreciate your help.
Steve