JDaniel1221
06-03-2015, 01:57 PM
Hello,
I am trying to get this Macro up and running again, but not sure where to start. It worked in Excel 2003, apparently my engineering department never upgraded to 2007, now my Desktop support person has upgraded them to 2010 and their Macros are blowing up left and right. This is one of the more critical ones, and the Debug takes me to the "Set fs = Application.FileSearch" line.
My background in Excel VBA is beg, borrow, and steal from smarter people than me and then manipulate it a little. I don't really "know" the syntax so much as I can navigate someone else's.
If you could help me get this one up and running in Excel 2010, that would be greatly appreciated.
Also, if there is a GENERIC way to fix "Set fs = Application.FileSearch" to make it more compatible with Excel 2010 that would be greatly appreciated. It sounds like they use to use it a lot and a lot of Macros are going to fail soon.
Thanks:
Sub OpenAndCloseAll()
'Open and update all cut lists
clcutdate = Sheets("INFO SHEET").Cells(1, 17) & "-" & Sheets("INFO SHEET").Cells(1, 20)
'drivelocation1 = "C:\Excel\"
drivelocation1 = "\\fltfile04\Production\044CNC\Excel\"
drivelocation2 = "\\fltfile04\Production\044CNC\Excel\Misc\CNC Office Macros\"
'drivelocation2 = "C:\Excel\Misc\CNC Office Macros\"
'psdrivelocation1 = "C:\Excel\Misc\Previous Schedules\" & clcutdate
psdrivelocation1 = "fltfile04\Production\044CNC\Excel\Misc\Previous Schedules\" & clcutdate
FillArrayVariables
'macrotorun = "VS 1 Cut List Formulas.XLS"
'macrotoopen = drivelocation2 & macrotorun
'Workbooks.Open macrotoopen
Set fs = Application.FileSearch
dummy = 0
Workbooks.Open Filename:=drivelocation1 & "2012\VS 2\CNC\2012 VS 2 CNC Schedule.xls", UpdateLinks:=0
ActiveWorkbook.Save
ActiveWorkbook.Close
With fs
.LookIn = drivelocation1 & "2012\VS 1\CNC"
.Filename = "*.xls"
.Execute
For i = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(i), UpdateLinks:=0
ActiveWorkbook.Save
'If (InStr(ActiveWorkbook.Name, "Tags") > 0) Then CreateScheduleBackUp
ActiveWorkbook.SaveAs psdrivelocation1 & "\VS 1\CNC\" & ActiveWorkbook.Name
ActiveWorkbook.Close
Next i
dummy = .FoundFiles.Count
End With
With fs
.LookIn = drivelocation1 & "2012\VS 1\Decor Tied"
.Filename = "*.xls"
.Execute
For i = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(i), UpdateLinks:=0
'Application.Run ("'" & macrotorun & "'" & "!CutListFormulas")
Application.StatusBar = "UPDATED : " & ActiveWorkbook.Name
ActiveWorkbook.Save
ActiveWorkbook.SaveAs psdrivelocation1 & "\VS 1\Decor Tied\" & ActiveWorkbook.Name
If (InStr(ActiveWorkbook.Name, "ACCENT") > 0 Or InStr(ActiveWorkbook.Name, "HDWD") > 0 Or (InStr(ActiveWorkbook.Name, "PREFINISH") > 0 And InStr(ActiveWorkbook.Name, "VS113") = 0)) Then
CreateHolzmaCutList
Else:
CreateScheduleBackUp
End If
Next i
dummy = dummy + .FoundFiles.Count
End With
With fs
.LookIn = drivelocation1 & "2012\VS 1\Pine&Plywood"
.Filename = "*.xls"
.Execute
For i = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(i), UpdateLinks:=0
'Application.Run ("'" & macrotorun & "'" & "!CutListFormulas")
Application.StatusBar = "UPDATED : " & ActiveWorkbook.Name
ActiveWorkbook.Save
ActiveWorkbook.SaveAs psdrivelocation1 & "\VS 1\Pine&Plywood\" & ActiveWorkbook.Name
If (InStr(ActiveWorkbook.Name, "PANEL SAW")) Then
CreateHolzmaCutList
Else:
CreateScheduleBackUp
End If
Next i
dummy = dummy + .FoundFiles.Count
End With
Application.StatusBar = dummy & " CUT LISTS UPDATED"
'Windows("Panel Saw Totals.xls").Activate
'ActiveWorkbook.Save
'ActiveWorkbook.Close
'Windows("Pine Totals.xls").Activate
'ActiveWorkbook.Save
'ActiveWorkbook.Close
End Sub
I am trying to get this Macro up and running again, but not sure where to start. It worked in Excel 2003, apparently my engineering department never upgraded to 2007, now my Desktop support person has upgraded them to 2010 and their Macros are blowing up left and right. This is one of the more critical ones, and the Debug takes me to the "Set fs = Application.FileSearch" line.
My background in Excel VBA is beg, borrow, and steal from smarter people than me and then manipulate it a little. I don't really "know" the syntax so much as I can navigate someone else's.
If you could help me get this one up and running in Excel 2010, that would be greatly appreciated.
Also, if there is a GENERIC way to fix "Set fs = Application.FileSearch" to make it more compatible with Excel 2010 that would be greatly appreciated. It sounds like they use to use it a lot and a lot of Macros are going to fail soon.
Thanks:
Sub OpenAndCloseAll()
'Open and update all cut lists
clcutdate = Sheets("INFO SHEET").Cells(1, 17) & "-" & Sheets("INFO SHEET").Cells(1, 20)
'drivelocation1 = "C:\Excel\"
drivelocation1 = "\\fltfile04\Production\044CNC\Excel\"
drivelocation2 = "\\fltfile04\Production\044CNC\Excel\Misc\CNC Office Macros\"
'drivelocation2 = "C:\Excel\Misc\CNC Office Macros\"
'psdrivelocation1 = "C:\Excel\Misc\Previous Schedules\" & clcutdate
psdrivelocation1 = "fltfile04\Production\044CNC\Excel\Misc\Previous Schedules\" & clcutdate
FillArrayVariables
'macrotorun = "VS 1 Cut List Formulas.XLS"
'macrotoopen = drivelocation2 & macrotorun
'Workbooks.Open macrotoopen
Set fs = Application.FileSearch
dummy = 0
Workbooks.Open Filename:=drivelocation1 & "2012\VS 2\CNC\2012 VS 2 CNC Schedule.xls", UpdateLinks:=0
ActiveWorkbook.Save
ActiveWorkbook.Close
With fs
.LookIn = drivelocation1 & "2012\VS 1\CNC"
.Filename = "*.xls"
.Execute
For i = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(i), UpdateLinks:=0
ActiveWorkbook.Save
'If (InStr(ActiveWorkbook.Name, "Tags") > 0) Then CreateScheduleBackUp
ActiveWorkbook.SaveAs psdrivelocation1 & "\VS 1\CNC\" & ActiveWorkbook.Name
ActiveWorkbook.Close
Next i
dummy = .FoundFiles.Count
End With
With fs
.LookIn = drivelocation1 & "2012\VS 1\Decor Tied"
.Filename = "*.xls"
.Execute
For i = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(i), UpdateLinks:=0
'Application.Run ("'" & macrotorun & "'" & "!CutListFormulas")
Application.StatusBar = "UPDATED : " & ActiveWorkbook.Name
ActiveWorkbook.Save
ActiveWorkbook.SaveAs psdrivelocation1 & "\VS 1\Decor Tied\" & ActiveWorkbook.Name
If (InStr(ActiveWorkbook.Name, "ACCENT") > 0 Or InStr(ActiveWorkbook.Name, "HDWD") > 0 Or (InStr(ActiveWorkbook.Name, "PREFINISH") > 0 And InStr(ActiveWorkbook.Name, "VS113") = 0)) Then
CreateHolzmaCutList
Else:
CreateScheduleBackUp
End If
Next i
dummy = dummy + .FoundFiles.Count
End With
With fs
.LookIn = drivelocation1 & "2012\VS 1\Pine&Plywood"
.Filename = "*.xls"
.Execute
For i = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(i), UpdateLinks:=0
'Application.Run ("'" & macrotorun & "'" & "!CutListFormulas")
Application.StatusBar = "UPDATED : " & ActiveWorkbook.Name
ActiveWorkbook.Save
ActiveWorkbook.SaveAs psdrivelocation1 & "\VS 1\Pine&Plywood\" & ActiveWorkbook.Name
If (InStr(ActiveWorkbook.Name, "PANEL SAW")) Then
CreateHolzmaCutList
Else:
CreateScheduleBackUp
End If
Next i
dummy = dummy + .FoundFiles.Count
End With
Application.StatusBar = dummy & " CUT LISTS UPDATED"
'Windows("Panel Saw Totals.xls").Activate
'ActiveWorkbook.Save
'ActiveWorkbook.Close
'Windows("Pine Totals.xls").Activate
'ActiveWorkbook.Save
'ActiveWorkbook.Close
End Sub