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("", 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.

[apeo]

I assume you cant use a SIMS report to mailmerge because you do something to the exported data first before you mailmerge it?