Hi
I wonder if anybody can help with this.
I have some code which will look at a cell value on my sheet (Which is a five-digit number), search in a directory open that folder and then open a subfolder within that folder & save the file.
This works just great if the parent folder & cell value are identical, but these parent folders will start with the 5 digit number then a space followed by some descriptive text.
Is there any way of searching just for the first 5 digits of a folder name?
Any help is always appreciated
I wonder if anybody can help with this.
I have some code which will look at a cell value on my sheet (Which is a five-digit number), search in a directory open that folder and then open a subfolder within that folder & save the file.
This works just great if the parent folder & cell value are identical, but these parent folders will start with the 5 digit number then a space followed by some descriptive text.
Is there any way of searching just for the first 5 digits of a folder name?
Any help is always appreciated
VBA Code:
Sub Save() 'Sub Save()' this is the save code so it will save to the correct TNumber folder
Dim CurrentSheet As Worksheet
Dim WB As Workbook
Set CurrentSheet = ActiveSheet
A = Cells(4, 3).Value 'row & column T number
'Application.DisplayAlerts = False
Set WB = ActiveWorkbook
' Changing drive letter
ChDrive "W:\"
' Changing directory
On Error GoTo InvalidDirectory
ChDir "W:\1WIS LIVE\" & A & "\11. Router & Inspection Report"
' Prompt for new file location
mySaveFile = Application.GetSaveAsFilename(Range("I4").Text & ".xlsm", "Microsoft Excel Workbook (*.xlsm), *.xlsm")
If mySaveFile = False Then Exit Sub
' Save
ActiveWorkbook.SaveAs Filename:=mySaveFile, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.Save
CurrentSheet.Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub
InvalidDirectory:
ChDir "W:\1WIS LIVE"
' Prompt for new file location
mySaveFile = Application.GetSaveAsFilename(Range("I4").Text & ".xlsm", "Microsoft Excel Workbook (*.xlsm), *.xlsm")
If mySaveFile = False Then Exit Sub
' Save
ActiveWorkbook.SaveAs Filename:=mySaveFile, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.Save
CurrentSheet.Select
Application.ScreenUpdating = True
'Application.DisplayAlerts = True
End Sub