Set path via VBA 1

[ChrisBurch]

I am automating a serires of Excel files. So far I have been able to programatically generate the filename, and set the saveas path to a sub-directory of the current directory, but need to be able to pickup up the directory path higher up.

eg. using ActiveWorkbook.path might give me

T:\departments\accounts\acntmgr\customer\difot and I can saveas T:\departments\accounts\AcntMgr\customer\difot\images\filename.xls. My problem is that I need to be able to save to a subfolder of \AcntMgr which will always be two directories higher that my current level. I don't want to hardcode the path, in case the files are moved to another drive or folder. However, since the current folder will always be 2 levels down from \AcntMgr how can I strip off the last 2 folders from the string returned by ActiveWorkbook.path?

Thanks for any advice,

Chris

It worked yesterday.
It doesn't work today.
That's Windows!

 

[sfvb]

Here's an example using the Split and Join functions.

Dim strPath    As String
Dim arrFolder  As Variant

strPath = ActiveWorkbook.Path
arrFolder = Split(strPath, "\")

    'break the path into parts delimited by the backslash

If UBound(arrFolder) > 1 Then
   ReDim Preserve arrFolder(UBound(arrFolder) - 2)")

    'drop the last two elements of the array

   strPath = Join(arrFolder, "\"))")

    'rejoin the path sans the last 2 folders

End If

[/color]

 

[sfvb]

Let me try that again:

Dim strPath    As String
Dim arrFolder  As Variant

strPath = ActiveWorkbook.Path
arrFolder = Split(strPath, "\")

    'break the path into parts delimited by the backslash

If UBound(arrFolder) > 1 Then
   ReDim Preserve arrFolder(UBound(arrFolder) - 2)

    'drop the last two elements of the array

   strPath = Join(arrFolder, "\")

    'rejoin the path sans the last 2 folders

End If

[/color]

 

[ChrisBurch]

Thanks sfvb,

Unfortunately the compiler is complaining that 'split' is not a defined function. I cannot find any reference to 'split' in my help menu, I should have stated in my question that I was using Excel 97, and I assume that this is where the problem lies.

Got any other thoughts?

Thanks,

Chris

It worked yesterday.
It doesn't work today.
That's Windows!

 

[sfvb]

This should work:

Dim strPath       As String
Dim intPosition   As Integer
Dim bolValid      As Boolean

strPath = ActiveWorkbook.Path

For idx = 1 To 2
   bolValid = False
   intPosition = InStrRev(strPath, "\")
   If intPosition > 0 Then
      strPath = Left(strPath, InStrRev(strPath, "\") - 1)
      bolValid = True
   End If
Next idx

If bolValid = False Then
   MsgBox ("Could not navigate to the parent folder")
Else
   'your code here
End If

 

[sfvb]

I just found out InStrRev doesn't work in 97, Try this:

Dim strPath          As String
Dim intPosition      As Integer
Dim intBack1         As Integer
Dim intBack2         As Integer

strPath = ActiveWorkbook.Path

intPosition = 0
intBack1 = 0
intBack2 = 0
Do
   intPosition = InStr(intPosition + 1, strPath, "\")
   If intPosition > 0 Then
      If intBack1 > 0 Then
         intBack2 = intBack1
      End If
      intBack1 = intPosition
   End If
Loop Until intPosition = 0

If intBack2 = 0 Then
   MsgBox ("Could not navigate to the parent folder")
Else
   strPath = Left(strPath, intBack2 - 1)
   'your code here
End If

 

[ChrisBurch]

Nup! That doesn't get me there either. After the first pass through the loop, strPath = "C" and IntPosition = 0 which then throws straight to the bolValid = false if statement.

Chris

It worked yesterday.
It doesn't work today.
That's Windows!

 

[ChrisBurch]

sfvb,

Ignore my previous post, it was in response to your previous post, and I hadn't seen your new on. I'll start testing now.

Thanks,

Chris

It worked yesterday.
It doesn't work today.
That's Windows!

 

[ChrisBurch]

Thanks sfvb,

That works a treat. I've stepped through it several times now, with watches, and I still can't work out what exactly it's doing. So at this point I'll just accept that it works, and leave the "why" 'til tomorrow.

Regards,

Chris

It worked yesterday.
It doesn't work today.
That's Windows!