frank_m
04-08-2012, 11:17 AM
This code browses for pdf files where the excels active cell value is a partial file name.
It works fine on 2003 and 2010 but on one 2007 machine at work, the dialog lists all the files (the InitialFileName is ignored)
* I'm 90% sure I've run this on a 2007 machine before without this issue.
Has anyone ever seen this happen before?
Edit: Using a msgbox I've verified that the PartNum Variable contains the activecell value
Sub Browse_Initial_FileName_is_Activecell()
Dim MyinitialFilename As String
Dim MyFullPath As String
Dim MyFileDialog As FileDialog 'As Object
Dim PartNum
Dim FSO As Object, StrRootDir As String
On Error GoTo errorHandler
Set FSO = CreateObject("Scripting.FileSystemObject")
StrRootDir = FSO.GetDriveName(ThisWorkbook.Path)
Set FSO = Nothing
ChDrive StrRootDir
ChDir StrRootDir & "\Blue Prints\"
PartNum = Replace(UCase(Trim(ActiveCell.EntireRow.Cells(7).Value)), "'", "")
MyFullPath = StrRootDir & "\Blue Prints\*" & PartNum & "*"
Set MyFileDialog = Application.FileDialog(msoFileDialogOpen)
With MyFileDialog
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "PDF Files", "*.pdf"
.InitialFileName = MyFullPath
.InitialView = msoFileDialogViewDetails
.Title = MyFullPath
If .Show = True Then
ActiveWorkbook.FollowHyperlink Address:=.SelectedItems(1)
End If
End With
ChDir ThisWorkbook.Path
Exit Sub
errorHandler:
Select Case Err.Number
Case 76
MsgBox Err.Description & ", Error# " & Err.Number _
& " - Make sure the Folder with the name Blue Prints is in the root directory of This Workbook."
Case Else
MsgBox Err.Description & ",Error# " & Err.Number & ", Please report to Frank"
End Select
End Sub
It works fine on 2003 and 2010 but on one 2007 machine at work, the dialog lists all the files (the InitialFileName is ignored)
* I'm 90% sure I've run this on a 2007 machine before without this issue.
Has anyone ever seen this happen before?
Edit: Using a msgbox I've verified that the PartNum Variable contains the activecell value
Sub Browse_Initial_FileName_is_Activecell()
Dim MyinitialFilename As String
Dim MyFullPath As String
Dim MyFileDialog As FileDialog 'As Object
Dim PartNum
Dim FSO As Object, StrRootDir As String
On Error GoTo errorHandler
Set FSO = CreateObject("Scripting.FileSystemObject")
StrRootDir = FSO.GetDriveName(ThisWorkbook.Path)
Set FSO = Nothing
ChDrive StrRootDir
ChDir StrRootDir & "\Blue Prints\"
PartNum = Replace(UCase(Trim(ActiveCell.EntireRow.Cells(7).Value)), "'", "")
MyFullPath = StrRootDir & "\Blue Prints\*" & PartNum & "*"
Set MyFileDialog = Application.FileDialog(msoFileDialogOpen)
With MyFileDialog
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "PDF Files", "*.pdf"
.InitialFileName = MyFullPath
.InitialView = msoFileDialogViewDetails
.Title = MyFullPath
If .Show = True Then
ActiveWorkbook.FollowHyperlink Address:=.SelectedItems(1)
End If
End With
ChDir ThisWorkbook.Path
Exit Sub
errorHandler:
Select Case Err.Number
Case 76
MsgBox Err.Description & ", Error# " & Err.Number _
& " - Make sure the Folder with the name Blue Prints is in the root directory of This Workbook."
Case Else
MsgBox Err.Description & ",Error# " & Err.Number & ", Please report to Frank"
End Select
End Sub