Find a file in excel VBA

[Stuart_C]

Is there a way to find and return the full path to a file on the PC?
For example I want to find Word on my PC and have it return c:\program files\microsoft office\Office14\Winword.exe or at least the directory path.

I can probably fudge it using some long winded IF statements and checking to see if the file exists but I was wondering for s slightly cleaner way.

[Steve21]

Is there a way to find and return the full path to a file on the PC?
For example I want to find Word on my PC and have it return c:\program files\microsoft office\Office14\Winword.exe or at least the directory path.

I can probably fudge it using some long winded IF statements and checking to see if the file exists but I was wondering for s slightly cleaner way.

Can you just clarify, you want to find a file from a fileopen dialog box within excel ?

Steve

[CESIL]

Are you trying to do some sort of audit to see which computers have Word (or other applications) installed?

If so there are plenty of free solutions out there that can do this sort of thing...

[Stuart_C]

The full scenario is this,
I am dropping a load of data from our MIS into Excel, manipulating it a little in excel then opening a mail merge document which will produce the notices I need. For this to happen automatically I need open the Word document which I am doing using Shell command to execute Word with the appropiate file name. However to do that I need to know the exact location of Winword.exe

At the minute I could just use nested if statements to find the version of word on my PC or the secretary who is most likely going to be using this (OfficeVal is then passed to the shell command)

    Dim OfficeVal As String
    Dim Office2010 As String
    Dim Office2007 As String
    
    Office2010 = "c:\Program Files\Microsoft Office\Office14\EXCEL.EXE"
    Office2007 = "c:\Program Files\Microsoft Office\Office12\EXCEL.EXE"
    
    If Dir(Office2010) <> "" Then
        OfficeVal = Office2010
    Else
        If Dir(Office2007) <> "" Then
            OfficeVal = Office2007
        Else
            MsgBox "No Idea about Office"
        End If
    End If

The problem here is that it won't work on 64bit machine as Office will be in the Program files (x86) dir and it doesn't future proof the file (for when Office 2013 is released ).
So yes I could put in more IF's but I was looking for a cleaner way.

In theory this would be by the macro searching the c:\drive for winword.exe and returning the full path to the exe

Hope that makse sense.

[andy_b]

Do you need to use Shell?

Else this should work

    Set wordapp = CreateObject("word.Application")

    wordapp.documents.Open "C:\...........\worddocument.doc"

    wordapp.Visible = True

[Steve21]

In theory this would be by the macro searching the c:\drive for winword.exe and returning the full path to the exe

A slighty longer, but "cleaner" way to do it would be cheating, and looking up the program designed to open the .doc (aka what's set to system default for the .doc? .docx etc)

(Note, Original code stolen and modified a bit)

Private Declare Function FindExecutable Lib "shell32" _
   Alias "FindExecutableA" _
  (ByVal lpFile As String, _
   ByVal lpDirectory As String, _
   ByVal sResult As String) As Long

Private Const MAX_PATH As Long = 260
Private Const ERROR_FILE_NO_ASSOCIATION As Long = 31
Private Const ERROR_FILE_NOT_FOUND As Long = 2
Private Const ERROR_PATH_NOT_FOUND As Long = 3
Private Const ERROR_FILE_SUCCESS As Long = 32
Private Const ERROR_BAD_FORMAT As Long = 11


Private Sub Command1_Click()

   Dim success As Long
   Dim pos As Long
   Dim sResult As String
   Dim msg As String
   
   sResult = Space$(MAX_PATH)

   Dim sFile$
   sFile = "\\sdrew\Documents\Stuff\test.docx"
   success = FindExecutable(sFile, "", sResult)

      
   Select Case success
      Case ERROR_FILE_NO_ASSOCIATION: msg = "no association"
      Case ERROR_FILE_NOT_FOUND: msg = "file not found"
      Case ERROR_PATH_NOT_FOUND: msg = "path not found"
      Case ERROR_BAD_FORMAT:     msg = "bad format"
      
      Case Is >= ERROR_FILE_SUCCESS:
         
         pos = InStr(sResult, Chr$(0))
         
         If pos Then
            msg = Left$(sResult, pos - 1)
         End If
         
   End Select
   
   MsgBox msg
   
End Sub

Then just remove the msgbox msg and run "msg" as a shell instead etc etc.

Any use? or prefer simpler way?

Will return any exe that is set to default to open the file type (just change filename to whatever you're using)

Steve

[CESIL]

I do this the way that @andy_b suggested...

[mac_shinobi]

The full scenario is this,
I am dropping a load of data from our MIS into Excel, manipulating it a little in excel then opening a mail merge document which will produce the notices I need. For this to happen automatically I need open the Word document which I am doing using Shell command to execute Word with the appropiate file name. However to do that I need to know the exact location of Winword.exe

At the minute I could just use nested if statements to find the version of word on my PC or the secretary who is most likely going to be using this (OfficeVal is then passed to the shell command)

    Dim OfficeVal As String
    Dim Office2010 As String
    Dim Office2007 As String
    
    Office2010 = "c:\Program Files\Microsoft Office\Office14\EXCEL.EXE"
    Office2007 = "c:\Program Files\Microsoft Office\Office12\EXCEL.EXE"
    
    If Dir(Office2010) <> "" Then
        OfficeVal = Office2010
    Else
        If Dir(Office2007) <> "" Then
            OfficeVal = Office2007
        Else
            MsgBox "No Idea about Office"
        End If
    End If

The problem here is that it won't work on 64bit machine as Office will be in the Program files (x86) dir and it doesn't future proof the file (for when Office 2013 is released ).
So yes I could put in more IF's but I was looking for a cleaner way.

In theory this would be by the macro searching the c:\drive for winword.exe and returning the full path to the exe

Hope that makse sense.

you can enumerate the reg keys for the diff versions of office which will return office 10, office 11 etc which translates to different office versions and go from there as you can enumerate through the relevant sub keys of the registry key

[Stuart_C]

Do you need to use Shell?

Else this should work

    Set wordapp = CreateObject("word.Application")

    wordapp.documents.Open "C:\...........\worddocument.doc"

    wordapp.Visible = True

I thouhgt I did
That seems to work. Cheers.

[Stuart_C]

Hmm.. Slight update here. It appears that I can't use Andy_b's way.

The document I am trying to open is a mail merge template. When I open the document using that method it looses the merge source information. If I open it using the shell command I am prompted to merge the data in as normal.

Why would that be?

[Steve21]

Hmm.. Slight update here. It appears that I can't use Andy_b's way.

The document I am trying to open is a mail merge template. When I open the document using that method it looses the merge source information. If I open it using the shell command I am prompted to merge the data in as normal.

Why would that be?

Have you actually opened the mailmerge source in the code?

Steve

[Stuart_C]

Yes and no. The code in Excel opens the source file, copys the data in then saves and closes the mail merge source then opens the mail merge file. There is then a macro in the mail merge file that runs on AutoOpen which simply runs a mail merge. This fails if I run it using the documents.open method but works if I run the Shell method of opening the document.

At the risk of exposing my ignorance here is all my code

In Excel

    Dim DETFileName As String
    Dim SelRange As String
    Dim FindEOR As String
    
    Range("A2:F150").Select
    Selection.Copy
    Workbooks.Open Filename:="T:\Training_Materials\SIMSRep\HMC_Totals.xlsx"
    Range("A2:F150").Select
    Application.DisplayAlerts = False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Application.DisplayAlerts = True
    Calculate
    
    FindEOR = Application.Match("<EOR>", Range("I2:I40"), 0)
    SelRange = "A1:I" & FindEOR
    
    Sheets("Sheet2").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    Sheets("Sheet1").Select
    Range(SelRange).Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Sheet1").Select
    ActiveWorkbook.Save
    ActiveWindow.Close
    DETFileName = """T:\Training_Materials\SIMSRep\HMC List.docm"""
    Shell "c:\Program Files\Microsoft Office\Office14\WINWORD.EXE " & DETFileName, vbNormalFocus
Rem    Set wordapp = CreateObject("word.Application")
Rem    wordapp.documents.Open "T:\Training_Materials\SIMSRep\HMC List.docm"
Rem    wordapp.Visible = True

In Word

    With ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
    End With
    Windows("HMC List").Activate
    ActiveWindow.Close savechanges:=wdDoNotSaveChanges

I know I've not named my worksheets in excel. Just to clarify here is my process.

Data exported from SIMS. data copied into mail merge source document. Data copied from sheet1 (with formulas) to sheet2 (no formula's data only - so mail merge works). Save and close. Open word document. Word documents opens, perfomrs merge and closes source template. Thus the end user is just left with report then need.

[CESIL]

Private Sub loadTemplate(myType As String)

    Dim oApp As New Word.Application
    Dim oDoc As Word.Document
    Dim fPath As String
    
    Call export_XLS
    
    fPath = "H:\OfficeShare\labels\"

    Select Case myType

        Case "Book"
            Set oDoc = oApp.Documents.Open(fPath & "Labels_Book.doc")
   
    End Select
            
    oDoc.MailMerge.OpenDataSource Name:= _
        "\\webserver\inetpub\db\labeldata.xls", ConfirmConversions:=False, _
        ReadOnly:=True, LinkToSource:=True, AddToRecentFiles:=False, _
        PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
        WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
        Connection:= _
        "Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=\\webserver\inetpub\db\labeldata.xls;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:En" _
        , SQLStatement:="SELECT * FROM `labelsource`", SQLStatement1:="", SubType _
        :=wdMergeSubTypeAccess

    oDoc.MailMerge.Destination = wdSendToNewDocument
    oDoc.MailMerge.Execute
    
    oDoc.Close SaveChanges:=wdDoNotSaveChanges
    oApp.Application.Visible = True

[Stuart_C]

*Puts thinking cap on*
OK. That sort of makes sense. I'll have a bit of a play and see how I get on, cheers.

I hate programming, it's a shame you can do so many cool things with it

[Stuart_C]

Cheers for that. Think I've got it working now. Possibly... well until it goes wrong anyway.