Open window - on error

[al007]

Sub Opendefactivewkbk()
On Error GoTo ErrorTrap1
ChDrive ActiveWorkbook.Path
ChDir ActiveWorkbook.Path
FName = Application.GetOpenFilename()
ErrorTrap1:
ChDrive "D"
FName = Application.GetOpenFilename()
If FName <> False Then Workbooks.Open FName

End Sub

The above macro works well without the on error - however i need it in
case i want to open a file from an active workbook which has not yet
been saved.
My problem is that I have 2 open window appearing one after the other
if there is no error.
an anybody correct my code pls
thxs

 

[Norman Jones]

Hi AL007,

Try:

'=============>>
Sub Opendefactivewkbk()
Dim FName

If ActiveWorkbook.Path <> vbNullString Then
ChDrive ActiveWorkbook.Path
ChDir ActiveWorkbook.Path
Else
ChDrive "D"
End If

FName = Application.GetOpenFilename()
If FName <> False Then Workbooks.Open FName

End Sub
'<<=============

 

[al007]

thxs !!!

Hi AL007,

Try:

'=============>>
Sub Opendefactivewkbk()
Dim FName

If ActiveWorkbook.Path <> vbNullString Then
ChDrive ActiveWorkbook.Path
ChDir ActiveWorkbook.Path
Else
ChDrive "D"
End If

FName = Application.GetOpenFilename()
If FName <> False Then Workbooks.Open FName

End Sub
'<<=============

 

[al007]

Norman,
sorry to trouble u, but have tested the code & it does not work -
it's not opening folder of my current active workbook (but my last
opened folder) & it does not work if I apply it when I have no active
workbook open - can u help pls
thxs

 

[Norman Jones]

Hi Al007,

Try:

'=============>>
Sub Opendefactivewkbk()
Dim wb As Workbook
Dim FName
Dim myDir As String

myDir = CurDir

On Error Resume Next
Set wb = ActiveWorkbook
On Error GoTo 0

If Not wb Is Nothing Then
If ActiveWorkbook.Path <> vbNullString Then
ChDrive ActiveWorkbook.Path
ChDir ActiveWorkbook.Path
End If
Else
ChDrive "D" '<<==== CHANGE
ChDir "D:\Test" '<<==== CHANGE

End If

FName = Application.GetOpenFilename()
If FName <> False Then Workbooks.Open FName

ChDrive myDir
ChDir myDir

End Sub
'<<=============

 

[al007]

perfect!! - thxs

Hi Al007,

Try:

'=============>>
Sub Opendefactivewkbk()
Dim wb As Workbook
Dim FName
Dim myDir As String

myDir = CurDir

On Error Resume Next
Set wb = ActiveWorkbook
On Error GoTo 0

If Not wb Is Nothing Then
If ActiveWorkbook.Path <> vbNullString Then
ChDrive ActiveWorkbook.Path
ChDir ActiveWorkbook.Path
End If
Else
ChDrive "D" '<<==== CHANGE
ChDir "D:\Test" '<<==== CHANGE

End If

FName = Application.GetOpenFilename()
If FName <> False Then Workbooks.Open FName

ChDrive myDir
ChDir myDir

End Sub
'<<=============