Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
I want Excel to determine the correct directory.
I have this one last problem that has been the baine of my existence for the
last couple years. I have a macro that goes to various places on our network and imports Excel spreadsheets into the spread sheet that I run the macro from. The directory and file names change each week and they are named for the Friday or Saturday of the week. To make things more exciting, the formats are different. The Friday format is mmddyy and the Saturday format is yymmdd. For example, this weeks Friday date is 030708 and Saturday is 080308. So this week the directory that I need to open would be \\fileserver\data\Global\Programs\PublicationOrder ing\080308 and a file named \\FileServer\Data\Global\Programs\PublicationOrder ing\YYMMDD\MWE_030708.XLS Next week they will be different. The problem I'm having is how to get Excel to figure out the end of week dates and open the directory or file accordingly. The only solution that I've been able to come up with to this point is to copy and replace the real dates for the generic mmddy and yymmdd before I run the macro. I use VLOOKUP in two cells to look up the Friday and Saturday dates in their correct format so I know what to paste into the macro. But I want Excel to figure all of this out. I tried to use a macro to copy and replace into another macro and that didn't work. There's got to be a way to do this! Here is a sample of the macro that I use. This is before I copy and replace the dates so you should see the generic date codes in the macro still. ' To use this you must replace the two different dates to match the current date. ' Replace the YYMMDD, in 6 places, to this week's Saturday date and replace MMDDYY, in 13 places, with this weeks Friday date. ' Dim Message, Title Message = "To use this macro you must first replace the mmddy and YYMMDD dates to match this weeks date. Hit OK to continue or CANCEL to stop." Title = "Are you sure you want to continue?" mynum = Application.InputBox(Message, Title) If mynum < "" Then End ChDir "\\fileserver\data\Global\Programs\PublicationOrde ring\YYMMDD" ' Open WMT Work Order Workbooks.Open Filename:= _ "\\FileServer\Data\Global\Programs\PublicationOrde ring\YYMMDD\MWE_MMDDYY.XLS" Sheets("B 1").Select Selection.Copy Windows("Machinery Run Sheet.xls").Activate Sheets("WMT Work Order").Select Application.Goto Reference:="R1C1" Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range("C27:D62").Select Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False ' Open EMT Work Order Workbooks.Open Filename:= _ "\\FileServer\Data\Global\Programs\PublicationOrde ring\YYMMDD\MEA_MMDDYY.XLS" Sheets("B 1").Select Selection.Copy Windows("Machinery Run Sheet.xls").Activate Sheets("EMT Work Order").Select Application.Goto Reference:="R1C1" Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range("C27:D62").Select Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False Application.Goto Reference:="R1C1" ' Open CMT Work Order Workbooks.Open Filename:= _ "\\FileServer\Data\Global\Programs\PublicationOrde ring\YYMMDD\MCE_MMDDYY.XLS" Sheets("B 1").Select Selection.Copy Windows("Machinery Run Sheet.xls").Activate Sheets("CMT Work Order").Select Application.Goto Reference:="R1C1" Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Range("C27:D62").Select Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False Application.Goto Reference:="R1C1" ' Clear Clipboard Sheets("Input").Select Range("A2:A3").Select Selection.Copy Application.CutCopyMode = False Range("A2").Select ' Close Work Orders Windows("MWE_MMDDYY.XLS").Activate ActiveWindow.Close Windows("MEA_MMDDYY.XLS").Activate ActiveWindow.Close Windows("MCE_MMDDYY.XLS").Activate ActiveWindow.Close 'Import Western Machinery Data Dim WMTStandard As Integer WMTStandard = Worksheets("Input").Cells(11, 2) If WMTStandard 0 Then GoTo Line1: GoTo Line2: Line1: Sheets("MATWESTB").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=\\Prism1\C\Labels\MTWEMMDDYYSTD.mdb;Mode=Sh are Deny W" _ , _ "rite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Eng" _ , _ "ine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:" _ , _ "New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on " _ , _ "Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=ActiveCell) .CommandType = xlCmdTable .CommandText = Array("DATA") .Name = "MATWESTB" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = "\\Prism1\C\Labels\MTWEMMDDYYSTD.mdb" .Refresh BackgroundQuery:=False End With GoTo Line3: Line2: Sheets("MATWESTB").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=\\Prism1\C\Labels\MTWEMMDDYYBPM.mdb;Mode=Sh are Deny W" _ , _ "rite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Eng" _ , _ "ine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:" _ , _ "New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on " _ , _ "Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=ActiveCell) .CommandType = xlCmdTable .CommandText = Array("DATA") .Name = "MATWESTB" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = "\\Prism1\C\Labels\MTWEMMDDYYbpm.mdb" .Refresh BackgroundQuery:=False End With Line3: Columns("F:F").Select Selection.Replace What:="/*", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Range("A1").Select 'Import Eastern Machinery Data Dim EMTStandard As Integer EMTStandard = Worksheets("Input").Cells(11, 3) If EMTStandard 0 Then GoTo Line4: GoTo Line5: Line4: Sheets("MATEASTB").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=\\Prism1\C\Labels\MTEAMMDDYYSTD.mdb;Mode=Sh are Deny W" _ , _ "rite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Eng" _ , _ "ine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:" _ , _ "New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on " _ , _ "Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=ActiveCell) .CommandType = xlCmdTable .CommandText = Array("DATA") .Name = "MATEASTB" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = "\\Prism1\C\Labels\MTEAMMDDYYSTD.mdb" .Refresh BackgroundQuery:=False End With GoTo Line4: Line5: Sheets("MATEASTB").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=\\Prism1\C\Labels\MTEAMMDDYYBPM.mdb;Mode=Sh are Deny W" _ , _ "rite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Eng" _ , _ "ine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:" _ , _ "New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on " _ , _ "Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=ActiveCell) .CommandType = xlCmdTable .CommandText = Array("DATA") .Name = "MATEASTB" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = "\\Prism1\C\Labels\MTEAMMDDYYbpm.mdb" .Refresh BackgroundQuery:=False End With Line6: Columns("F:F").Select Selection.Replace What:="/*", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Range("A1").Select 'Import Central Machinery Data CMTStandard = Worksheets("Input").Cells(11, 4) If CMTStandard 0 Then GoTo LINE7: GoTo LINE8: LINE7: Sheets("MATCENTB").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=\\Prism1\C\Labels\MTCEMMDDYYSTD.mdb;Mode=Sh are Deny W" _ , _ "rite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Eng" _ , _ "ine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:" _ , _ "New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on " _ , _ "Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=ActiveCell) .CommandType = xlCmdTable .CommandText = Array("DATA") .Name = "MATCENTB" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = "\\Prism1\C\Labels\MTCEMMDDYYSTD.mdb" .Refresh BackgroundQuery:=False End With GoTo LINE7: LINE8: Sheets("MATCENTB").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=\\Prism1\C\Labels\MTCEMMDDYYBPM.mdb;Mode=Sh are Deny W" _ , _ "rite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Eng" _ , _ "ine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:" _ , _ "New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on " _ , _ "Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=ActiveCell) .CommandType = xlCmdTable .CommandText = Array("DATA") .Name = "MATCENTB" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = "\\Prism1\C\Labels\MTCEMMDDYYbpm.mdb" .Refresh BackgroundQuery:=False End With LINE9: Columns("F:F").Select Selection.Replace What:="/*", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Range("A1").Select Sheets("Input").Select End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
I want Excel to determine the correct directory.
I've had to deal with the same issue with dates whithin a sheet since
I work for an international company. Europeans like the YYMMDD format and Americans like the MMDDYY format. I don't want to try and understand your code but I'll give a few hinds for how I handled it: try something along these lines: sub formatDate(strDateFormat as string, strFileDirectory as string) dim mm, dd, yy as integer dim strFileName as string strFileName = dir(strFileDirectory) 'separate file name from directory if dateFormat = "YYMMDD" then yy = left(strFileName, 2) mm = right(left(strFileName, 4),2) dd = right(left(strFileName, 6),2) else mm = left(strFileName, 2) dd = right(left(strFileName, 4),2) yy = right(left(strFileName, 6),2) end if 'then do something with the separate variables, 'likely concatenate (with &) each variable in the appropriate format. end sub That's a quick and dirty, but I hope it'll help. Cheers! Nate |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
I want Excel to determine the correct directory.
where do you get the dates from, 03/07/08 and 03/08/08?
this is just something simple that will show how to concatenate the date in the immediate window if a1 contains either 03/07/08 or 03/08/08 Sub test() Dim dstr As Variant dstr = Split(Range("A1").Text, "/") If Weekday(Range("A1"), 1) = 6 Then Debug.Print "\\fileserver\data\Global\Programs\PublicationOrde ring\" & dstr(0); dstr(1); dstr(2) ElseIf Weekday(Range("A1"), 1) = 7 Then Debug.Print "\\fileserver\data\Global\Programs\PublicationOrde ring\" & dstr(2); dstr(0); dstr(1) End If End Sub -- Gary "Don M." wrote in message ... I have this one last problem that has been the baine of my existence for the last couple years. I have a macro that goes to various places on our network and imports Excel spreadsheets into the spread sheet that I run the macro from. The directory and file names change each week and they are named for the Friday or Saturday of the week. To make things more exciting, the formats are different. The Friday format is mmddyy and the Saturday format is yymmdd. For example, this weeks Friday date is 030708 and Saturday is 080308. So this week the directory that I need to open would be \\fileserver\data\Global\Programs\PublicationOrder ing\080308 and a file named \\FileServer\Data\Global\Programs\PublicationOrder ing\YYMMDD\MWE_030708.XLS Next week they will be different. The problem I'm having is how to get Excel to figure out the end of week dates and open the directory or file accordingly. The only solution that I've been able to come up with to this point is to copy and replace the real dates for the generic mmddy and yymmdd before I run the macro. I use VLOOKUP in two cells to look up the Friday and Saturday dates in their correct format so I know what to paste into the macro. But I want Excel to figure all of this out. I tried to use a macro to copy and replace into another macro and that didn't work. There's got to be a way to do this! Here is a sample of the macro that I use. This is before I copy and replace the dates so you should see the generic date codes in the macro still. ' To use this you must replace the two different dates to match the current date. ' Replace the YYMMDD, in 6 places, to this week's Saturday date and replace MMDDYY, in 13 places, with this weeks Friday date. ' Dim Message, Title Message = "To use this macro you must first replace the mmddy and YYMMDD dates to match this weeks date. Hit OK to continue or CANCEL to stop." Title = "Are you sure you want to continue?" mynum = Application.InputBox(Message, Title) If mynum < "" Then End ChDir "\\fileserver\data\Global\Programs\PublicationOrde ring\YYMMDD" ' Open WMT Work Order Workbooks.Open Filename:= _ "\\FileServer\Data\Global\Programs\PublicationOrde ring\YYMMDD\MWE_MMDDYY.XLS" Sheets("B 1").Select Selection.Copy Windows("Machinery Run Sheet.xls").Activate Sheets("WMT Work Order").Select Application.Goto Reference:="R1C1" Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range("C27:D62").Select Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False ' Open EMT Work Order Workbooks.Open Filename:= _ "\\FileServer\Data\Global\Programs\PublicationOrde ring\YYMMDD\MEA_MMDDYY.XLS" Sheets("B 1").Select Selection.Copy Windows("Machinery Run Sheet.xls").Activate Sheets("EMT Work Order").Select Application.Goto Reference:="R1C1" Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range("C27:D62").Select Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False Application.Goto Reference:="R1C1" ' Open CMT Work Order Workbooks.Open Filename:= _ "\\FileServer\Data\Global\Programs\PublicationOrde ring\YYMMDD\MCE_MMDDYY.XLS" Sheets("B 1").Select Selection.Copy Windows("Machinery Run Sheet.xls").Activate Sheets("CMT Work Order").Select Application.Goto Reference:="R1C1" Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Range("C27:D62").Select Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False Application.Goto Reference:="R1C1" ' Clear Clipboard Sheets("Input").Select Range("A2:A3").Select Selection.Copy Application.CutCopyMode = False Range("A2").Select ' Close Work Orders Windows("MWE_MMDDYY.XLS").Activate ActiveWindow.Close Windows("MEA_MMDDYY.XLS").Activate ActiveWindow.Close Windows("MCE_MMDDYY.XLS").Activate ActiveWindow.Close 'Import Western Machinery Data Dim WMTStandard As Integer WMTStandard = Worksheets("Input").Cells(11, 2) If WMTStandard 0 Then GoTo Line1: GoTo Line2: Line1: Sheets("MATWESTB").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=\\Prism1\C\Labels\MTWEMMDDYYSTD.mdb;Mode=Sh are Deny W" _ , _ "rite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Eng" _ , _ "ine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:" _ , _ "New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on " _ , _ "Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=ActiveCell) .CommandType = xlCmdTable .CommandText = Array("DATA") .Name = "MATWESTB" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = "\\Prism1\C\Labels\MTWEMMDDYYSTD.mdb" .Refresh BackgroundQuery:=False End With GoTo Line3: Line2: Sheets("MATWESTB").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=\\Prism1\C\Labels\MTWEMMDDYYBPM.mdb;Mode=Sh are Deny W" _ , _ "rite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Eng" _ , _ "ine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:" _ , _ "New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on " _ , _ "Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=ActiveCell) .CommandType = xlCmdTable .CommandText = Array("DATA") .Name = "MATWESTB" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = "\\Prism1\C\Labels\MTWEMMDDYYbpm.mdb" .Refresh BackgroundQuery:=False End With Line3: Columns("F:F").Select Selection.Replace What:="/*", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Range("A1").Select 'Import Eastern Machinery Data Dim EMTStandard As Integer EMTStandard = Worksheets("Input").Cells(11, 3) If EMTStandard 0 Then GoTo Line4: GoTo Line5: Line4: Sheets("MATEASTB").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=\\Prism1\C\Labels\MTEAMMDDYYSTD.mdb;Mode=Sh are Deny W" _ , _ "rite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Eng" _ , _ "ine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:" _ , _ "New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on " _ , _ "Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=ActiveCell) .CommandType = xlCmdTable .CommandText = Array("DATA") .Name = "MATEASTB" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = "\\Prism1\C\Labels\MTEAMMDDYYSTD.mdb" .Refresh BackgroundQuery:=False End With GoTo Line4: Line5: Sheets("MATEASTB").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=\\Prism1\C\Labels\MTEAMMDDYYBPM.mdb;Mode=Sh are Deny W" _ , _ "rite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Eng" _ , _ "ine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:" _ , _ "New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on " _ , _ "Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=ActiveCell) .CommandType = xlCmdTable .CommandText = Array("DATA") .Name = "MATEASTB" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = "\\Prism1\C\Labels\MTEAMMDDYYbpm.mdb" .Refresh BackgroundQuery:=False End With Line6: Columns("F:F").Select Selection.Replace What:="/*", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Range("A1").Select 'Import Central Machinery Data CMTStandard = Worksheets("Input").Cells(11, 4) If CMTStandard 0 Then GoTo LINE7: GoTo LINE8: LINE7: Sheets("MATCENTB").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=\\Prism1\C\Labels\MTCEMMDDYYSTD.mdb;Mode=Sh are Deny W" _ , _ "rite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Eng" _ , _ "ine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:" _ , _ "New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on " _ , _ "Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=ActiveCell) .CommandType = xlCmdTable .CommandText = Array("DATA") .Name = "MATCENTB" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = "\\Prism1\C\Labels\MTCEMMDDYYSTD.mdb" .Refresh BackgroundQuery:=False End With GoTo LINE7: LINE8: Sheets("MATCENTB").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=\\Prism1\C\Labels\MTCEMMDDYYBPM.mdb;Mode=Sh are Deny W" _ , _ "rite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Eng" _ , _ "ine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:" _ , _ "New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on " _ , _ "Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=ActiveCell) .CommandType = xlCmdTable .CommandText = Array("DATA") .Name = "MATCENTB" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = "\\Prism1\C\Labels\MTCEMMDDYYbpm.mdb" .Refresh BackgroundQuery:=False End With LINE9: Columns("F:F").Select Selection.Replace What:="/*", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Range("A1").Select Sheets("Input").Select End Sub |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
I want Excel to determine the correct directory.
and make sure lines beginning with debug are all on the same line, because oe
wordwraps it: Debug.Print "\\fileserver\data\Global\Programs\PublicationOrde ring\" & dstr(2); dstr(0); dstr(1) -- Gary "Gary Keramidas" <GKeramidasATmsn.com wrote in message ... where do you get the dates from, 03/07/08 and 03/08/08? this is just something simple that will show how to concatenate the date in the immediate window if a1 contains either 03/07/08 or 03/08/08 Sub test() Dim dstr As Variant dstr = Split(Range("A1").Text, "/") If Weekday(Range("A1"), 1) = 6 Then Debug.Print "\\fileserver\data\Global\Programs\PublicationOrde ring\" & dstr(0); dstr(1); dstr(2) ElseIf Weekday(Range("A1"), 1) = 7 Then Debug.Print "\\fileserver\data\Global\Programs\PublicationOrde ring\" & dstr(2); dstr(0); dstr(1) End If End Sub -- Gary "Don M." wrote in message ... I have this one last problem that has been the baine of my existence for the last couple years. I have a macro that goes to various places on our network and imports Excel spreadsheets into the spread sheet that I run the macro from. The directory and file names change each week and they are named for the Friday or Saturday of the week. To make things more exciting, the formats are different. The Friday format is mmddyy and the Saturday format is yymmdd. For example, this weeks Friday date is 030708 and Saturday is 080308. So this week the directory that I need to open would be \\fileserver\data\Global\Programs\PublicationOrder ing\080308 and a file named \\FileServer\Data\Global\Programs\PublicationOrder ing\YYMMDD\MWE_030708.XLS Next week they will be different. The problem I'm having is how to get Excel to figure out the end of week dates and open the directory or file accordingly. The only solution that I've been able to come up with to this point is to copy and replace the real dates for the generic mmddy and yymmdd before I run the macro. I use VLOOKUP in two cells to look up the Friday and Saturday dates in their correct format so I know what to paste into the macro. But I want Excel to figure all of this out. I tried to use a macro to copy and replace into another macro and that didn't work. There's got to be a way to do this! Here is a sample of the macro that I use. This is before I copy and replace the dates so you should see the generic date codes in the macro still. ' To use this you must replace the two different dates to match the current date. ' Replace the YYMMDD, in 6 places, to this week's Saturday date and replace MMDDYY, in 13 places, with this weeks Friday date. ' Dim Message, Title Message = "To use this macro you must first replace the mmddy and YYMMDD dates to match this weeks date. Hit OK to continue or CANCEL to stop." Title = "Are you sure you want to continue?" mynum = Application.InputBox(Message, Title) If mynum < "" Then End ChDir "\\fileserver\data\Global\Programs\PublicationOrde ring\YYMMDD" ' Open WMT Work Order Workbooks.Open Filename:= _ "\\FileServer\Data\Global\Programs\PublicationOrde ring\YYMMDD\MWE_MMDDYY.XLS" Sheets("B 1").Select Selection.Copy Windows("Machinery Run Sheet.xls").Activate Sheets("WMT Work Order").Select Application.Goto Reference:="R1C1" Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range("C27:D62").Select Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False ' Open EMT Work Order Workbooks.Open Filename:= _ "\\FileServer\Data\Global\Programs\PublicationOrde ring\YYMMDD\MEA_MMDDYY.XLS" Sheets("B 1").Select Selection.Copy Windows("Machinery Run Sheet.xls").Activate Sheets("EMT Work Order").Select Application.Goto Reference:="R1C1" Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range("C27:D62").Select Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False Application.Goto Reference:="R1C1" ' Open CMT Work Order Workbooks.Open Filename:= _ "\\FileServer\Data\Global\Programs\PublicationOrde ring\YYMMDD\MCE_MMDDYY.XLS" Sheets("B 1").Select Selection.Copy Windows("Machinery Run Sheet.xls").Activate Sheets("CMT Work Order").Select Application.Goto Reference:="R1C1" Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Range("C27:D62").Select Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False Application.Goto Reference:="R1C1" ' Clear Clipboard Sheets("Input").Select Range("A2:A3").Select Selection.Copy Application.CutCopyMode = False Range("A2").Select ' Close Work Orders Windows("MWE_MMDDYY.XLS").Activate ActiveWindow.Close Windows("MEA_MMDDYY.XLS").Activate ActiveWindow.Close Windows("MCE_MMDDYY.XLS").Activate ActiveWindow.Close 'Import Western Machinery Data Dim WMTStandard As Integer WMTStandard = Worksheets("Input").Cells(11, 2) If WMTStandard 0 Then GoTo Line1: GoTo Line2: Line1: Sheets("MATWESTB").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=\\Prism1\C\Labels\MTWEMMDDYYSTD.mdb;Mode=Sh are Deny W" _ , _ "rite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Eng" _ , _ "ine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:" _ , _ "New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on " _ , _ "Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=ActiveCell) .CommandType = xlCmdTable .CommandText = Array("DATA") .Name = "MATWESTB" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = "\\Prism1\C\Labels\MTWEMMDDYYSTD.mdb" .Refresh BackgroundQuery:=False End With GoTo Line3: Line2: Sheets("MATWESTB").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=\\Prism1\C\Labels\MTWEMMDDYYBPM.mdb;Mode=Sh are Deny W" _ , _ "rite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Eng" _ , _ "ine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:" _ , _ "New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on " _ , _ "Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=ActiveCell) .CommandType = xlCmdTable .CommandText = Array("DATA") .Name = "MATWESTB" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = "\\Prism1\C\Labels\MTWEMMDDYYbpm.mdb" .Refresh BackgroundQuery:=False End With Line3: Columns("F:F").Select Selection.Replace What:="/*", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Range("A1").Select 'Import Eastern Machinery Data Dim EMTStandard As Integer EMTStandard = Worksheets("Input").Cells(11, 3) If EMTStandard 0 Then GoTo Line4: GoTo Line5: Line4: Sheets("MATEASTB").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=\\Prism1\C\Labels\MTEAMMDDYYSTD.mdb;Mode=Sh are Deny W" _ , _ "rite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Eng" _ , _ "ine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:" _ , _ "New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on " _ , _ "Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=ActiveCell) .CommandType = xlCmdTable .CommandText = Array("DATA") .Name = "MATEASTB" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = "\\Prism1\C\Labels\MTEAMMDDYYSTD.mdb" .Refresh BackgroundQuery:=False End With GoTo Line4: Line5: Sheets("MATEASTB").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=\\Prism1\C\Labels\MTEAMMDDYYBPM.mdb;Mode=Sh are Deny W" _ , _ "rite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Eng" _ , _ "ine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:" _ , _ "New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on " _ , _ "Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=ActiveCell) .CommandType = xlCmdTable .CommandText = Array("DATA") .Name = "MATEASTB" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = "\\Prism1\C\Labels\MTEAMMDDYYbpm.mdb" .Refresh BackgroundQuery:=False End With Line6: Columns("F:F").Select Selection.Replace What:="/*", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Range("A1").Select 'Import Central Machinery Data CMTStandard = Worksheets("Input").Cells(11, 4) If CMTStandard 0 Then GoTo LINE7: GoTo LINE8: LINE7: Sheets("MATCENTB").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=\\Prism1\C\Labels\MTCEMMDDYYSTD.mdb;Mode=Sh are Deny W" _ , _ "rite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Eng" _ , _ "ine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:" _ , _ "New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on " _ , _ "Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=ActiveCell) .CommandType = xlCmdTable .CommandText = Array("DATA") .Name = "MATCENTB" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = "\\Prism1\C\Labels\MTCEMMDDYYSTD.mdb" .Refresh BackgroundQuery:=False End With GoTo LINE7: LINE8: Sheets("MATCENTB").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=\\Prism1\C\Labels\MTCEMMDDYYBPM.mdb;Mode=Sh are Deny W" _ , _ "rite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Eng" _ , _ "ine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:" _ , _ "New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on " _ , _ "Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=ActiveCell) .CommandType = xlCmdTable .CommandText = Array("DATA") .Name = "MATCENTB" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = "\\Prism1\C\Labels\MTCEMMDDYYbpm.mdb" .Refresh BackgroundQuery:=False End With LINE9: Columns("F:F").Select Selection.Replace What:="/*", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Range("A1").Select Sheets("Input").Select End Sub |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
I want Excel to determine the correct directory.
Thank you Gary. At this point I have a VLOOKUP that gets the correct Saturday
and Friday date for me, already in the correct format, i.e. 080308 and 030708 for this week. For this example lets say the two dates are in H1 and H2 on Sheet "Input", respectively. I'm not clear on how to use your code to concatenate the complete filename or directory so that it includes these formatted dates and then uses them. Can you elaborate some more, please? Don "Gary Keramidas" wrote: where do you get the dates from, 03/07/08 and 03/08/08? this is just something simple that will show how to concatenate the date in the immediate window if a1 contains either 03/07/08 or 03/08/08 Sub test() Dim dstr As Variant dstr = Split(Range("A1").Text, "/") If Weekday(Range("A1"), 1) = 6 Then Debug.Print "\\fileserver\data\Global\Programs\PublicationOrde ring\" & dstr(0); dstr(1); dstr(2) ElseIf Weekday(Range("A1"), 1) = 7 Then Debug.Print "\\fileserver\data\Global\Programs\PublicationOrde ring\" & dstr(2); dstr(0); dstr(1) End If End Sub -- Gary "Don M." wrote in message ... I have this one last problem that has been the baine of my existence for the last couple years. I have a macro that goes to various places on our network and imports Excel spreadsheets into the spread sheet that I run the macro from. The directory and file names change each week and they are named for the Friday or Saturday of the week. To make things more exciting, the formats are different. The Friday format is mmddyy and the Saturday format is yymmdd. For example, this weeks Friday date is 030708 and Saturday is 080308. So this week the directory that I need to open would be \\fileserver\data\Global\Programs\PublicationOrder ing\080308 and a file named \\FileServer\Data\Global\Programs\PublicationOrder ing\YYMMDD\MWE_030708.XLS Next week they will be different. The problem I'm having is how to get Excel to figure out the end of week dates and open the directory or file accordingly. The only solution that I've been able to come up with to this point is to copy and replace the real dates for the generic mmddy and yymmdd before I run the macro. I use VLOOKUP in two cells to look up the Friday and Saturday dates in their correct format so I know what to paste into the macro. But I want Excel to figure all of this out. I tried to use a macro to copy and replace into another macro and that didn't work. There's got to be a way to do this! Here is a sample of the macro that I use. This is before I copy and replace the dates so you should see the generic date codes in the macro still. ' To use this you must replace the two different dates to match the current date. ' Replace the YYMMDD, in 6 places, to this week's Saturday date and replace MMDDYY, in 13 places, with this weeks Friday date. ' Dim Message, Title Message = "To use this macro you must first replace the mmddy and YYMMDD dates to match this weeks date. Hit OK to continue or CANCEL to stop." Title = "Are you sure you want to continue?" mynum = Application.InputBox(Message, Title) If mynum < "" Then End ChDir "\\fileserver\data\Global\Programs\PublicationOrde ring\YYMMDD" ' Open WMT Work Order Workbooks.Open Filename:= _ "\\FileServer\Data\Global\Programs\PublicationOrde ring\YYMMDD\MWE_MMDDYY.XLS" Sheets("B 1").Select Selection.Copy Windows("Machinery Run Sheet.xls").Activate Sheets("WMT Work Order").Select Application.Goto Reference:="R1C1" Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range("C27:D62").Select Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False ' Open EMT Work Order Workbooks.Open Filename:= _ "\\FileServer\Data\Global\Programs\PublicationOrde ring\YYMMDD\MEA_MMDDYY.XLS" Sheets("B 1").Select Selection.Copy Windows("Machinery Run Sheet.xls").Activate Sheets("EMT Work Order").Select Application.Goto Reference:="R1C1" Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range("C27:D62").Select Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False Application.Goto Reference:="R1C1" ' Open CMT Work Order Workbooks.Open Filename:= _ "\\FileServer\Data\Global\Programs\PublicationOrde ring\YYMMDD\MCE_MMDDYY.XLS" Sheets("B 1").Select Selection.Copy Windows("Machinery Run Sheet.xls").Activate Sheets("CMT Work Order").Select Application.Goto Reference:="R1C1" Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Range("C27:D62").Select Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False Application.Goto Reference:="R1C1" ' Clear Clipboard Sheets("Input").Select Range("A2:A3").Select Selection.Copy Application.CutCopyMode = False Range("A2").Select ' Close Work Orders Windows("MWE_MMDDYY.XLS").Activate ActiveWindow.Close Windows("MEA_MMDDYY.XLS").Activate ActiveWindow.Close Windows("MCE_MMDDYY.XLS").Activate ActiveWindow.Close 'Import Western Machinery Data Dim WMTStandard As Integer WMTStandard = Worksheets("Input").Cells(11, 2) If WMTStandard 0 Then GoTo Line1: GoTo Line2: Line1: Sheets("MATWESTB").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=\\Prism1\C\Labels\MTWEMMDDYYSTD.mdb;Mode=Sh are Deny W" _ , _ "rite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Eng" _ , _ "ine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:" _ , _ "New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on " _ , _ "Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=ActiveCell) .CommandType = xlCmdTable .CommandText = Array("DATA") .Name = "MATWESTB" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = "\\Prism1\C\Labels\MTWEMMDDYYSTD.mdb" .Refresh BackgroundQuery:=False End With GoTo Line3: Line2: Sheets("MATWESTB").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=\\Prism1\C\Labels\MTWEMMDDYYBPM.mdb;Mode=Sh are Deny W" _ , _ "rite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Eng" _ , _ "ine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:" _ , _ "New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on " _ , _ "Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=ActiveCell) .CommandType = xlCmdTable .CommandText = Array("DATA") .Name = "MATWESTB" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = "\\Prism1\C\Labels\MTWEMMDDYYbpm.mdb" .Refresh BackgroundQuery:=False End With Line3: Columns("F:F").Select Selection.Replace What:="/*", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Range("A1").Select 'Import Eastern Machinery Data Dim EMTStandard As Integer EMTStandard = Worksheets("Input").Cells(11, 3) If EMTStandard 0 Then GoTo Line4: GoTo Line5: Line4: Sheets("MATEASTB").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=\\Prism1\C\Labels\MTEAMMDDYYSTD.mdb;Mode=Sh are Deny W" _ , _ "rite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Eng" _ , _ "ine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:" _ , _ "New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on " _ , _ "Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=ActiveCell) .CommandType = xlCmdTable .CommandText = Array("DATA") .Name = "MATEASTB" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = "\\Prism1\C\Labels\MTEAMMDDYYSTD.mdb" .Refresh BackgroundQuery:=False End With GoTo Line4: Line5: Sheets("MATEASTB").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=\\Prism1\C\Labels\MTEAMMDDYYBPM.mdb;Mode=Sh are Deny W" _ , _ "rite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Eng" _ , _ "ine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:" _ , _ "New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on " _ , _ "Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=ActiveCell) .CommandType = xlCmdTable .CommandText = Array("DATA") .Name = "MATEASTB" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = "\\Prism1\C\Labels\MTEAMMDDYYbpm.mdb" .Refresh BackgroundQuery:=False |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
I want Excel to determine the correct directory.
not sure if your dates are always in the same location or not, but see if you
can adapt this: Sub test() Dim dstr As Variant dstr = Split(Range("H1").Text, "/") Dim fPath As String Dim fName As String Dim wb2 As Workbook fName = dstr(0) & dstr(1) & dstr(2) fPath = "\\fileserver\data\Global\Programs\PublicationOrde ring\" Set wb2 = Workbooks.Open(fPath & "MWE_" & fName & ".xls") End Sub -- Gary "Don M." wrote in message ... Thank you Gary. At this point I have a VLOOKUP that gets the correct Saturday and Friday date for me, already in the correct format, i.e. 080308 and 030708 for this week. For this example lets say the two dates are in H1 and H2 on Sheet "Input", respectively. I'm not clear on how to use your code to concatenate the complete filename or directory so that it includes these formatted dates and then uses them. Can you elaborate some more, please? Don "Gary Keramidas" wrote: where do you get the dates from, 03/07/08 and 03/08/08? this is just something simple that will show how to concatenate the date in the immediate window if a1 contains either 03/07/08 or 03/08/08 Sub test() Dim dstr As Variant dstr = Split(Range("A1").Text, "/") If Weekday(Range("A1"), 1) = 6 Then Debug.Print "\\fileserver\data\Global\Programs\PublicationOrde ring\" & dstr(0); dstr(1); dstr(2) ElseIf Weekday(Range("A1"), 1) = 7 Then Debug.Print "\\fileserver\data\Global\Programs\PublicationOrde ring\" & dstr(2); dstr(0); dstr(1) End If End Sub -- Gary "Don M." wrote in message ... I have this one last problem that has been the baine of my existence for the last couple years. I have a macro that goes to various places on our network and imports Excel spreadsheets into the spread sheet that I run the macro from. The directory and file names change each week and they are named for the Friday or Saturday of the week. To make things more exciting, the formats are different. The Friday format is mmddyy and the Saturday format is yymmdd. For example, this weeks Friday date is 030708 and Saturday is 080308. So this week the directory that I need to open would be \\fileserver\data\Global\Programs\PublicationOrder ing\080308 and a file named \\FileServer\Data\Global\Programs\PublicationOrder ing\YYMMDD\MWE_030708.XLS Next week they will be different. The problem I'm having is how to get Excel to figure out the end of week dates and open the directory or file accordingly. The only solution that I've been able to come up with to this point is to copy and replace the real dates for the generic mmddy and yymmdd before I run the macro. I use VLOOKUP in two cells to look up the Friday and Saturday dates in their correct format so I know what to paste into the macro. But I want Excel to figure all of this out. I tried to use a macro to copy and replace into another macro and that didn't work. There's got to be a way to do this! Here is a sample of the macro that I use. This is before I copy and replace the dates so you should see the generic date codes in the macro still. ' To use this you must replace the two different dates to match the current date. ' Replace the YYMMDD, in 6 places, to this week's Saturday date and replace MMDDYY, in 13 places, with this weeks Friday date. ' Dim Message, Title Message = "To use this macro you must first replace the mmddy and YYMMDD dates to match this weeks date. Hit OK to continue or CANCEL to stop." Title = "Are you sure you want to continue?" mynum = Application.InputBox(Message, Title) If mynum < "" Then End ChDir "\\fileserver\data\Global\Programs\PublicationOrde ring\YYMMDD" ' Open WMT Work Order Workbooks.Open Filename:= _ "\\FileServer\Data\Global\Programs\PublicationOrde ring\YYMMDD\MWE_MMDDYY.XLS" Sheets("B 1").Select Selection.Copy Windows("Machinery Run Sheet.xls").Activate Sheets("WMT Work Order").Select Application.Goto Reference:="R1C1" Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range("C27:D62").Select Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False ' Open EMT Work Order Workbooks.Open Filename:= _ "\\FileServer\Data\Global\Programs\PublicationOrde ring\YYMMDD\MEA_MMDDYY.XLS" Sheets("B 1").Select Selection.Copy Windows("Machinery Run Sheet.xls").Activate Sheets("EMT Work Order").Select Application.Goto Reference:="R1C1" Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range("C27:D62").Select Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False Application.Goto Reference:="R1C1" ' Open CMT Work Order Workbooks.Open Filename:= _ "\\FileServer\Data\Global\Programs\PublicationOrde ring\YYMMDD\MCE_MMDDYY.XLS" Sheets("B 1").Select Selection.Copy Windows("Machinery Run Sheet.xls").Activate Sheets("CMT Work Order").Select Application.Goto Reference:="R1C1" Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Range("C27:D62").Select Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False Application.Goto Reference:="R1C1" ' Clear Clipboard Sheets("Input").Select Range("A2:A3").Select Selection.Copy Application.CutCopyMode = False Range("A2").Select ' Close Work Orders Windows("MWE_MMDDYY.XLS").Activate ActiveWindow.Close Windows("MEA_MMDDYY.XLS").Activate ActiveWindow.Close Windows("MCE_MMDDYY.XLS").Activate ActiveWindow.Close 'Import Western Machinery Data Dim WMTStandard As Integer WMTStandard = Worksheets("Input").Cells(11, 2) If WMTStandard 0 Then GoTo Line1: GoTo Line2: Line1: Sheets("MATWESTB").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=\\Prism1\C\Labels\MTWEMMDDYYSTD.mdb;Mode=Sh are Deny W" _ , _ "rite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Eng" _ , _ "ine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:" _ , _ "New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on " _ , _ "Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=ActiveCell) .CommandType = xlCmdTable .CommandText = Array("DATA") .Name = "MATWESTB" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = "\\Prism1\C\Labels\MTWEMMDDYYSTD.mdb" .Refresh BackgroundQuery:=False End With GoTo Line3: Line2: Sheets("MATWESTB").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=\\Prism1\C\Labels\MTWEMMDDYYBPM.mdb;Mode=Sh are Deny W" _ , _ "rite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Eng" _ , _ "ine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:" _ , _ "New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on " _ , _ "Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=ActiveCell) .CommandType = xlCmdTable .CommandText = Array("DATA") .Name = "MATWESTB" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = "\\Prism1\C\Labels\MTWEMMDDYYbpm.mdb" .Refresh BackgroundQuery:=False End With Line3: Columns("F:F").Select Selection.Replace What:="/*", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Range("A1").Select 'Import Eastern Machinery Data Dim EMTStandard As Integer EMTStandard = Worksheets("Input").Cells(11, 3) If EMTStandard 0 Then GoTo Line4: GoTo Line5: Line4: Sheets("MATEASTB").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=\\Prism1\C\Labels\MTEAMMDDYYSTD.mdb;Mode=Sh are Deny W" _ , _ "rite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Eng" _ , _ "ine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:" _ , _ "New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on " _ , _ "Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=ActiveCell) .CommandType = xlCmdTable .CommandText = Array("DATA") .Name = "MATEASTB" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = "\\Prism1\C\Labels\MTEAMMDDYYSTD.mdb" .Refresh BackgroundQuery:=False End With GoTo Line4: Line5: Sheets("MATEASTB").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=\\Prism1\C\Labels\MTEAMMDDYYBPM.mdb;Mode=Sh are Deny W" _ , _ "rite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Eng" _ , _ "ine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:" _ , _ "New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on " _ , _ "Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=ActiveCell) .CommandType = xlCmdTable .CommandText = Array("DATA") .Name = "MATEASTB" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = "\\Prism1\C\Labels\MTEAMMDDYYbpm.mdb" .Refresh BackgroundQuery:=False |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
I want Excel to determine the correct directory.
The dates are always in the same place and they are already in the "mmddyy"
and "yymmdd" format in those cells, H1 and H2. There aren't any slashes. I'm wondering if a combination of your code and Nates code in the other reply might be what I need. His code looks like it's breaking a string into three 2 digit segments and assigning the value to a variable, then combining those variables into the path name and filename using the ampersand to concatenate. I've been using a line such as this, Workbooks.Open Filename:= _ "\\FileServer\Data\Global\Programs\PublicationOrde ring\yymmdd\P___mmddyy.XLS" and just replacing the date code with the actual numbers. If I concatenate with variables I think something along this line would work, wouldn't it? Since I use both the Saturday and Friday dates in the same macro I need variables for the month, the year, Friday and Saturday of any given week. Once I have those variables set I think I should be able to concatenate them into correct paths and filenames. My syntax may be wrong, but I'm just trying to get a direction at this point. You can setup the spreadsheet pretty easily by typing these dates into H1 and H2 in a blank sheet. Cell H1 has 080308 in it using a VLOOKUP result for Saturday's date Cell H2 has 030708 in it using a VLOOKUP result for Friday's date. dim mm, fri, sat, yy as integer dim Friday as string dim Saturday as string Saturday = Worksheets("Input").Cells(1, 8) ' Saturday date in cell H1 Friday = Worksheets("Input").Cells(2, 8) ' Friday date in cell H2 yy = left(Saturday, 2) mm = left(Friday, 2) fri = right(left(Friday, 6),2) sat = right(left(Saturday, 6),2) Workbooks.Open Filename:= "\\FileServer\Data\Global\Programs\PublicationOrde ring\"&yy&mm&sat&"\P___"&mm&fri&yy&".XLS" Does something like that look like I'm on the right path? Don "Gary Keramidas" wrote: not sure if your dates are always in the same location or not, but see if you can adapt this: Sub test() Dim dstr As Variant dstr = Split(Range("H1").Text, "/") Dim fPath As String Dim fName As String Dim wb2 As Workbook fName = dstr(0) & dstr(1) & dstr(2) fPath = "\\fileserver\data\Global\Programs\PublicationOrde ring\" Set wb2 = Workbooks.Open(fPath & "MWE_" & fName & ".xls") End Sub -- Gary "Don M." wrote in message ... Thank you Gary. At this point I have a VLOOKUP that gets the correct Saturday and Friday date for me, already in the correct format, i.e. 080308 and 030708 for this week. For this example lets say the two dates are in H1 and H2 on Sheet "Input", respectively. I'm not clear on how to use your code to concatenate the complete filename or directory so that it includes these formatted dates and then uses them. Can you elaborate some more, please? Don "Gary Keramidas" wrote: where do you get the dates from, 03/07/08 and 03/08/08? this is just something simple that will show how to concatenate the date in the immediate window if a1 contains either 03/07/08 or 03/08/08 Sub test() Dim dstr As Variant dstr = Split(Range("A1").Text, "/") If Weekday(Range("A1"), 1) = 6 Then Debug.Print "\\fileserver\data\Global\Programs\PublicationOrde ring\" & dstr(0); dstr(1); dstr(2) ElseIf Weekday(Range("A1"), 1) = 7 Then Debug.Print "\\fileserver\data\Global\Programs\PublicationOrde ring\" & dstr(2); dstr(0); dstr(1) End If End Sub -- Gary "Don M." wrote in message ... I have this one last problem that has been the baine of my existence for the last couple years. I have a macro that goes to various places on our network and imports Excel spreadsheets into the spread sheet that I run the macro from. The directory and file names change each week and they are named for the Friday or Saturday of the week. To make things more exciting, the formats are different. The Friday format is mmddyy and the Saturday format is yymmdd. For example, this weeks Friday date is 030708 and Saturday is 080308. So this week the directory that I need to open would be \\fileserver\data\Global\Programs\PublicationOrder ing\080308 and a file named \\FileServer\Data\Global\Programs\PublicationOrder ing\YYMMDD\MWE_030708.XLS Next week they will be different. The problem I'm having is how to get Excel to figure out the end of week dates and open the directory or file accordingly. The only solution that I've been able to come up with to this point is to copy and replace the real dates for the generic mmddy and yymmdd before I run the macro. I use VLOOKUP in two cells to look up the Friday and Saturday dates in their correct format so I know what to paste into the macro. But I want Excel to figure all of this out. I tried to use a macro to copy and replace into another macro and that didn't work. There's got to be a way to do this! Here is a sample of the macro that I use. This is before I copy and replace the dates so you should see the generic date codes in the macro still. ' To use this you must replace the two different dates to match the current date. ' Replace the YYMMDD, in 6 places, to this week's Saturday date and replace MMDDYY, in 13 places, with this weeks Friday date. ' Dim Message, Title Message = "To use this macro you must first replace the mmddy and YYMMDD dates to match this weeks date. Hit OK to continue or CANCEL to stop." Title = "Are you sure you want to continue?" mynum = Application.InputBox(Message, Title) If mynum < "" Then End ChDir "\\fileserver\data\Global\Programs\PublicationOrde ring\YYMMDD" ' Open WMT Work Order Workbooks.Open Filename:= _ "\\FileServer\Data\Global\Programs\PublicationOrde ring\YYMMDD\MWE_MMDDYY.XLS" Sheets("B 1").Select Selection.Copy Windows("Machinery Run Sheet.xls").Activate Sheets("WMT Work Order").Select Application.Goto Reference:="R1C1" Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range("C27:D62").Select Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False ' Open EMT Work Order Workbooks.Open Filename:= _ "\\FileServer\Data\Global\Programs\PublicationOrde ring\YYMMDD\MEA_MMDDYY.XLS" Sheets("B 1").Select Selection.Copy Windows("Machinery Run Sheet.xls").Activate Sheets("EMT Work Order").Select Application.Goto Reference:="R1C1" Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range("C27:D62").Select Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False Application.Goto Reference:="R1C1" ' Open CMT Work Order Workbooks.Open Filename:= _ "\\FileServer\Data\Global\Programs\PublicationOrde ring\YYMMDD\MCE_MMDDYY.XLS" Sheets("B 1").Select Selection.Copy Windows("Machinery Run Sheet.xls").Activate Sheets("CMT Work Order").Select Application.Goto Reference:="R1C1" Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Range("C27:D62").Select Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False Application.Goto Reference:="R1C1" ' Clear Clipboard Sheets("Input").Select Range("A2:A3").Select Selection.Copy Application.CutCopyMode = False Range("A2").Select ' Close Work Orders Windows("MWE_MMDDYY.XLS").Activate ActiveWindow.Close Windows("MEA_MMDDYY.XLS").Activate ActiveWindow.Close Windows("MCE_MMDDYY.XLS").Activate ActiveWindow.Close 'Import Western Machinery Data Dim WMTStandard As Integer WMTStandard = Worksheets("Input").Cells(11, 2) If WMTStandard 0 Then GoTo Line1: GoTo Line2: Line1: Sheets("MATWESTB").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=\\Prism1\C\Labels\MTWEMMDDYYSTD.mdb;Mode=Sh are Deny W" _ , _ "rite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Eng" _ , _ "ine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:" _ , _ "New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on " _ , _ "Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=ActiveCell) .CommandType = xlCmdTable .CommandText = Array("DATA") .Name = "MATWESTB" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = "\\Prism1\C\Labels\MTWEMMDDYYSTD.mdb" .Refresh BackgroundQuery:=False End With GoTo Line3: Line2: Sheets("MATWESTB").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=\\Prism1\C\Labels\MTWEMMDDYYBPM.mdb;Mode=Sh are Deny W" _ , _ "rite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Eng" _ , _ "ine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:" _ , _ "New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on " _ , _ "Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=ActiveCell) .CommandType = xlCmdTable .CommandText = Array("DATA") .Name = "MATWESTB" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = "\\Prism1\C\Labels\MTWEMMDDYYbpm.mdb" .Refresh BackgroundQuery:=False End With Line3: Columns("F:F").Select Selection.Replace What:="/*", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Range("A1").Select 'Import Eastern Machinery Data Dim EMTStandard As Integer EMTStandard = Worksheets("Input").Cells(11, 3) If EMTStandard 0 Then GoTo Line4: GoTo Line5: Line4: Sheets("MATEASTB").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=\\Prism1\C\Labels\MTEAMMDDYYSTD.mdb;Mode=Sh are Deny W" _ , _ "rite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Eng" _ , _ "ine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:" _ , _ "New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on " _ , _ "Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=ActiveCell) .CommandType = xlCmdTable .CommandText = Array("DATA") .Name = "MATEASTB" |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
I want Excel to determine the correct directory.
if you already have h1 and h2 formatted how you want them, then you should just
be able to concatenate the value onto your path Sub test() Dim fPath As String Dim fName As String Dim wb2 As Workbook fPath = "\\FileServer\Data\Global\Programs\PublicationOrde ring\" & _ Range("H1").Value & "\" fName = Range("H2").Value & ".xls" Set wb2 = Workbooks.Open(fPath & "MWE_" & fName & ".xls") End Sub -- Gary "Don M." wrote in message ... The dates are always in the same place and they are already in the "mmddyy" and "yymmdd" format in those cells, H1 and H2. There aren't any slashes. I'm wondering if a combination of your code and Nates code in the other reply might be what I need. His code looks like it's breaking a string into three 2 digit segments and assigning the value to a variable, then combining those variables into the path name and filename using the ampersand to concatenate. I've been using a line such as this, Workbooks.Open Filename:= _ "\\FileServer\Data\Global\Programs\PublicationOrde ring\yymmdd\P___mmddyy.XLS" and just replacing the date code with the actual numbers. If I concatenate with variables I think something along this line would work, wouldn't it? Since I use both the Saturday and Friday dates in the same macro I need variables for the month, the year, Friday and Saturday of any given week. Once I have those variables set I think I should be able to concatenate them into correct paths and filenames. My syntax may be wrong, but I'm just trying to get a direction at this point. You can setup the spreadsheet pretty easily by typing these dates into H1 and H2 in a blank sheet. Cell H1 has 080308 in it using a VLOOKUP result for Saturday's date Cell H2 has 030708 in it using a VLOOKUP result for Friday's date. dim mm, fri, sat, yy as integer dim Friday as string dim Saturday as string Saturday = Worksheets("Input").Cells(1, 8) ' Saturday date in cell H1 Friday = Worksheets("Input").Cells(2, 8) ' Friday date in cell H2 yy = left(Saturday, 2) mm = left(Friday, 2) fri = right(left(Friday, 6),2) sat = right(left(Saturday, 6),2) Workbooks.Open Filename:= "\\FileServer\Data\Global\Programs\PublicationOrde ring\"&yy&mm&sat&"\P___"&mm&fri&yy&".XLS" Does something like that look like I'm on the right path? Don "Gary Keramidas" wrote: not sure if your dates are always in the same location or not, but see if you can adapt this: Sub test() Dim dstr As Variant dstr = Split(Range("H1").Text, "/") Dim fPath As String Dim fName As String Dim wb2 As Workbook fName = dstr(0) & dstr(1) & dstr(2) fPath = "\\fileserver\data\Global\Programs\PublicationOrde ring\" Set wb2 = Workbooks.Open(fPath & "MWE_" & fName & ".xls") End Sub -- Gary "Don M." wrote in message ... Thank you Gary. At this point I have a VLOOKUP that gets the correct Saturday and Friday date for me, already in the correct format, i.e. 080308 and 030708 for this week. For this example lets say the two dates are in H1 and H2 on Sheet "Input", respectively. I'm not clear on how to use your code to concatenate the complete filename or directory so that it includes these formatted dates and then uses them. Can you elaborate some more, please? Don "Gary Keramidas" wrote: where do you get the dates from, 03/07/08 and 03/08/08? this is just something simple that will show how to concatenate the date in the immediate window if a1 contains either 03/07/08 or 03/08/08 Sub test() Dim dstr As Variant dstr = Split(Range("A1").Text, "/") If Weekday(Range("A1"), 1) = 6 Then Debug.Print "\\fileserver\data\Global\Programs\PublicationOrde ring\" & dstr(0); dstr(1); dstr(2) ElseIf Weekday(Range("A1"), 1) = 7 Then Debug.Print "\\fileserver\data\Global\Programs\PublicationOrde ring\" & dstr(2); dstr(0); dstr(1) End If End Sub -- Gary "Don M." wrote in message ... I have this one last problem that has been the baine of my existence for the last couple years. I have a macro that goes to various places on our network and imports Excel spreadsheets into the spread sheet that I run the macro from. The directory and file names change each week and they are named for the Friday or Saturday of the week. To make things more exciting, the formats are different. The Friday format is mmddyy and the Saturday format is yymmdd. For example, this weeks Friday date is 030708 and Saturday is 080308. So this week the directory that I need to open would be \\fileserver\data\Global\Programs\PublicationOrder ing\080308 and a file named \\FileServer\Data\Global\Programs\PublicationOrder ing\YYMMDD\MWE_030708.XLS Next week they will be different. The problem I'm having is how to get Excel to figure out the end of week dates and open the directory or file accordingly. The only solution that I've been able to come up with to this point is to copy and replace the real dates for the generic mmddy and yymmdd before I run the macro. I use VLOOKUP in two cells to look up the Friday and Saturday dates in their correct format so I know what to paste into the macro. But I want Excel to figure all of this out. I tried to use a macro to copy and replace into another macro and that didn't work. There's got to be a way to do this! Here is a sample of the macro that I use. This is before I copy and replace the dates so you should see the generic date codes in the macro still. ' To use this you must replace the two different dates to match the current date. ' Replace the YYMMDD, in 6 places, to this week's Saturday date and replace MMDDYY, in 13 places, with this weeks Friday date. ' Dim Message, Title Message = "To use this macro you must first replace the mmddy and YYMMDD dates to match this weeks date. Hit OK to continue or CANCEL to stop." Title = "Are you sure you want to continue?" mynum = Application.InputBox(Message, Title) If mynum < "" Then End ChDir "\\fileserver\data\Global\Programs\PublicationOrde ring\YYMMDD" ' Open WMT Work Order Workbooks.Open Filename:= _ "\\FileServer\Data\Global\Programs\PublicationOrde ring\YYMMDD\MWE_MMDDYY.XLS" Sheets("B 1").Select Selection.Copy Windows("Machinery Run Sheet.xls").Activate Sheets("WMT Work Order").Select Application.Goto Reference:="R1C1" Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range("C27:D62").Select Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False ' Open EMT Work Order Workbooks.Open Filename:= _ "\\FileServer\Data\Global\Programs\PublicationOrde ring\YYMMDD\MEA_MMDDYY.XLS" Sheets("B 1").Select Selection.Copy Windows("Machinery Run Sheet.xls").Activate Sheets("EMT Work Order").Select Application.Goto Reference:="R1C1" Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range("C27:D62").Select Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False Application.Goto Reference:="R1C1" ' Open CMT Work Order Workbooks.Open Filename:= _ "\\FileServer\Data\Global\Programs\PublicationOrde ring\YYMMDD\MCE_MMDDYY.XLS" Sheets("B 1").Select Selection.Copy Windows("Machinery Run Sheet.xls").Activate Sheets("CMT Work Order").Select Application.Goto Reference:="R1C1" Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Range("C27:D62").Select Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False Application.Goto Reference:="R1C1" ' Clear Clipboard Sheets("Input").Select Range("A2:A3").Select Selection.Copy Application.CutCopyMode = False Range("A2").Select ' Close Work Orders Windows("MWE_MMDDYY.XLS").Activate ActiveWindow.Close Windows("MEA_MMDDYY.XLS").Activate ActiveWindow.Close Windows("MCE_MMDDYY.XLS").Activate ActiveWindow.Close 'Import Western Machinery Data Dim WMTStandard As Integer WMTStandard = Worksheets("Input").Cells(11, 2) If WMTStandard 0 Then GoTo Line1: GoTo Line2: Line1: Sheets("MATWESTB").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=\\Prism1\C\Labels\MTWEMMDDYYSTD.mdb;Mode=Sh are Deny W" _ , _ "rite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Eng" _ , _ "ine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:" _ , _ "New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on " _ , _ "Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=ActiveCell) .CommandType = xlCmdTable .CommandText = Array("DATA") .Name = "MATWESTB" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = "\\Prism1\C\Labels\MTWEMMDDYYSTD.mdb" .Refresh BackgroundQuery:=False End With GoTo Line3: Line2: Sheets("MATWESTB").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=\\Prism1\C\Labels\MTWEMMDDYYBPM.mdb;Mode=Sh are Deny W" _ , _ "rite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Eng" _ , _ "ine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:" _ , _ "New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on " _ , _ "Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=ActiveCell) .CommandType = xlCmdTable .CommandText = Array("DATA") .Name = "MATWESTB" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = "\\Prism1\C\Labels\MTWEMMDDYYbpm.mdb" .Refresh BackgroundQuery:=False End With Line3: Columns("F:F").Select Selection.Replace What:="/*", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Range("A1").Select 'Import Eastern Machinery Data Dim EMTStandard As Integer EMTStandard = Worksheets("Input").Cells(11, 3) If EMTStandard 0 Then GoTo Line4: GoTo Line5: Line4: Sheets("MATEASTB").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=\\Prism1\C\Labels\MTEAMMDDYYSTD.mdb;Mode=Sh are Deny W" _ , _ "rite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Eng" _ , _ "ine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:" _ , _ "New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on " _ , _ "Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=ActiveCell) .CommandType = xlCmdTable .CommandText = Array("DATA") .Name = "MATEASTB" |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
I want Excel to determine the correct directory.
Yes, you are right, there. I forgot that I had those cells formatted to look
that way. The actual values in them are true dates, 3/7/2008 and 3/8/2008. I just have those two cells formatted to display the date format that I want them to show. This explains the trouble I was having with the code that I had in my last reply. The code was creating the path exactly as I was telling it to, only it was using the date, i.e. 3/8/2008, as the source for the various string segments. I couldn't figure out why I was getting a 20 as part of the path. Mid(Saturday, 5, 2) when Saturday=3/8/2008 is 20. DUH! This is what the table looks like, but the Friday and Saturday columns are formatted to display these numbers. The actual data in those columns is really 3/7/2008 and 3/8/2008 and so on. Today Friday Saturday 3/3/08 030708 080308 3/4/08 030708 080308 3/5/08 030708 080308 3/6/08 030708 080308 3/7/08 030708 080308 3/8/08 030708 080308 3/10/08 031408 080315 3/11/08 031408 080315 3/12/08 031408 080315 3/13/08 031408 080315 3/14/08 031408 080315 3/15/08 031408 080315 I could go through the huge task of creating a new table with the exact format of dates that I want and then VLOOKUP out of that table and then use the code I had to rebuild the path and filename. However, there should be a way to make Excel figure out these things for itself and avoid all of the time that would take me. I'm in the process of breaking down Nate's code some more. I have to go slow and look up every command before I really understand what's going on. I'm not an expert in VB, not even close. But I still think that a combination of the code you both gave me should work. In the end I want Excel to, if I run this macro today, build the path with this Saturday's date, 080308, and the filename with this Friday's date, 030708, all by itself without any VLOOKUP or any of that stuff. Thanks for sticking with me, Gary. Don "Gary Keramidas" wrote: if you already have h1 and h2 formatted how you want them, then you should just be able to concatenate the value onto your path Sub test() Dim fPath As String Dim fName As String Dim wb2 As Workbook fPath = "\\FileServer\Data\Global\Programs\PublicationOrde ring\" & _ Range("H1").Value & "\" fName = Range("H2").Value & ".xls" Set wb2 = Workbooks.Open(fPath & "MWE_" & fName & ".xls") End Sub -- Gary "Don M." wrote in message ... The dates are always in the same place and they are already in the "mmddyy" and "yymmdd" format in those cells, H1 and H2. There aren't any slashes. I'm wondering if a combination of your code and Nates code in the other reply might be what I need. His code looks like it's breaking a string into three 2 digit segments and assigning the value to a variable, then combining those variables into the path name and filename using the ampersand to concatenate. I've been using a line such as this, Workbooks.Open Filename:= _ "\\FileServer\Data\Global\Programs\PublicationOrde ring\yymmdd\P___mmddyy.XLS" and just replacing the date code with the actual numbers. If I concatenate with variables I think something along this line would work, wouldn't it? Since I use both the Saturday and Friday dates in the same macro I need variables for the month, the year, Friday and Saturday of any given week. Once I have those variables set I think I should be able to concatenate them into correct paths and filenames. My syntax may be wrong, but I'm just trying to get a direction at this point. You can setup the spreadsheet pretty easily by typing these dates into H1 and H2 in a blank sheet. Cell H1 has 080308 in it using a VLOOKUP result for Saturday's date Cell H2 has 030708 in it using a VLOOKUP result for Friday's date. dim mm, fri, sat, yy as integer dim Friday as string dim Saturday as string Saturday = Worksheets("Input").Cells(1, 8) ' Saturday date in cell H1 Friday = Worksheets("Input").Cells(2, 8) ' Friday date in cell H2 yy = left(Saturday, 2) mm = left(Friday, 2) fri = right(left(Friday, 6),2) sat = right(left(Saturday, 6),2) Workbooks.Open Filename:= "\\FileServer\Data\Global\Programs\PublicationOrde ring\"&yy&mm&sat&"\P___"&mm&fri&yy&".XLS" Does something like that look like I'm on the right path? Don "Gary Keramidas" wrote: not sure if your dates are always in the same location or not, but see if you can adapt this: Sub test() Dim dstr As Variant dstr = Split(Range("H1").Text, "/") Dim fPath As String Dim fName As String Dim wb2 As Workbook fName = dstr(0) & dstr(1) & dstr(2) fPath = "\\fileserver\data\Global\Programs\PublicationOrde ring\" Set wb2 = Workbooks.Open(fPath & "MWE_" & fName & ".xls") End Sub -- Gary "Don M." wrote in message ... Thank you Gary. At this point I have a VLOOKUP that gets the correct Saturday and Friday date for me, already in the correct format, i.e. 080308 and 030708 for this week. For this example lets say the two dates are in H1 and H2 on Sheet "Input", respectively. I'm not clear on how to use your code to concatenate the complete filename or directory so that it includes these formatted dates and then uses them. Can you elaborate some more, please? Don "Gary Keramidas" wrote: where do you get the dates from, 03/07/08 and 03/08/08? this is just something simple that will show how to concatenate the date in the immediate window if a1 contains either 03/07/08 or 03/08/08 Sub test() Dim dstr As Variant dstr = Split(Range("A1").Text, "/") If Weekday(Range("A1"), 1) = 6 Then Debug.Print "\\fileserver\data\Global\Programs\PublicationOrde ring\" & dstr(0); dstr(1); dstr(2) ElseIf Weekday(Range("A1"), 1) = 7 Then Debug.Print "\\fileserver\data\Global\Programs\PublicationOrde ring\" & dstr(2); dstr(0); dstr(1) End If End Sub -- Gary "Don M." wrote in message ... I have this one last problem that has been the baine of my existence for the last couple years. I have a macro that goes to various places on our network and imports Excel spreadsheets into the spread sheet that I run the macro from. The directory and file names change each week and they are named for the Friday or Saturday of the week. To make things more exciting, the formats are different. The Friday format is mmddyy and the Saturday format is yymmdd. For example, this weeks Friday date is 030708 and Saturday is 080308. So this week the directory that I need to open would be \\fileserver\data\Global\Programs\PublicationOrder ing\080308 and a file named \\FileServer\Data\Global\Programs\PublicationOrder ing\YYMMDD\MWE_030708.XLS Next week they will be different. The problem I'm having is how to get Excel to figure out the end of week dates and open the directory or file accordingly. The only solution that I've been able to come up with to this point is to copy and replace the real dates for the generic mmddy and yymmdd before I run the macro. I use VLOOKUP in two cells to look up the Friday and Saturday dates in their correct format so I know what to paste into the macro. But I want Excel to figure all of this out. I tried to use a macro to copy and replace into another macro and that didn't work. There's got to be a way to do this! Here is a sample of the macro that I use. This is before I copy and replace the dates so you should see the generic date codes in the macro still. ' To use this you must replace the two different dates to match the current date. ' Replace the YYMMDD, in 6 places, to this week's Saturday date and replace MMDDYY, in 13 places, with this weeks Friday date. ' Dim Message, Title Message = "To use this macro you must first replace the mmddy and YYMMDD dates to match this weeks date. Hit OK to continue or CANCEL to stop." Title = "Are you sure you want to continue?" mynum = Application.InputBox(Message, Title) If mynum < "" Then End ChDir "\\fileserver\data\Global\Programs\PublicationOrde ring\YYMMDD" ' Open WMT Work Order Workbooks.Open Filename:= _ "\\FileServer\Data\Global\Programs\PublicationOrde ring\YYMMDD\MWE_MMDDYY.XLS" Sheets("B 1").Select Selection.Copy Windows("Machinery Run Sheet.xls").Activate Sheets("WMT Work Order").Select Application.Goto Reference:="R1C1" Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range("C27:D62").Select Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False ' Open EMT Work Order Workbooks.Open Filename:= _ "\\FileServer\Data\Global\Programs\PublicationOrde ring\YYMMDD\MEA_MMDDYY.XLS" Sheets("B 1").Select Selection.Copy Windows("Machinery Run Sheet.xls").Activate Sheets("EMT Work Order").Select Application.Goto Reference:="R1C1" Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range("C27:D62").Select Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False Application.Goto Reference:="R1C1" ' Open CMT Work Order Workbooks.Open Filename:= _ "\\FileServer\Data\Global\Programs\PublicationOrde ring\YYMMDD\MCE_MMDDYY.XLS" Sheets("B 1").Select Selection.Copy Windows("Machinery Run Sheet.xls").Activate Sheets("CMT Work Order").Select Application.Goto Reference:="R1C1" Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Range("C27:D62").Select Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False Application.Goto Reference:="R1C1" ' Clear Clipboard Sheets("Input").Select Range("A2:A3").Select Selection.Copy Application.CutCopyMode = False Range("A2").Select ' Close Work Orders Windows("MWE_MMDDYY.XLS").Activate ActiveWindow.Close Windows("MEA_MMDDYY.XLS").Activate ActiveWindow.Close Windows("MCE_MMDDYY.XLS").Activate ActiveWindow.Close 'Import Western Machinery Data Dim WMTStandard As Integer WMTStandard = Worksheets("Input").Cells(11, 2) If WMTStandard 0 Then GoTo Line1: GoTo Line2: Line1: Sheets("MATWESTB").Select With ActiveSheet.QueryTables.Add(Connection:=Array( _ "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=" """;User ID=Admin;Data Source=\\Prism1\C\Labels\MTWEMMDDYYSTD.mdb;Mode=Sh are Deny W" _ , _ "rite;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Eng" _ , _ "ine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:" _ , _ "New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on " _ , _ "Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _ ), Destination:=ActiveCell) .CommandType = xlCmdTable .CommandText = Array("DATA") .Name = "MATWESTB" |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
I want Excel to determine the correct directory.
Thank you Nate. A combination of your code and Gary's code got my wheels
turning and I was able to do exactly what I needed. In the end I realized I also had to verify whether or not the date values were single or double digits. If they were signle I had to add a Zero to the value so the filenames and paths would work. I also had to know what day of the week it was today so that I could accurately determine what the Friday and Saturday values would be. Here's what I ended up with: Dim MyDate, MyMonth, MyDay, MyYear, Zero, MyWeekday Zero = 0 ' Year MyYear = Year(Now()) ' Number of this year yy = Right(MyYear, 2) ' Month MyMonth = Month(Now()) ' Number of this month mm = MyMonth If mm < 10 Then mm = Zero & mm ' What day of the week is it today? MyWeekday = Weekday(Now(), 1) If MyWeekday = 2 Then GoTo Line1001: ' Today is Monday If MyWeekday = 3 Then GoTo Line1002: ' Today is Tuesday If MyWeekday = 4 Then GoTo Line1003: ' Today is Wednesday If MyWeekday = 5 Then GoTo Line1004: ' Today is Thursday If MyWeekday = 6 Then GoTo Line1005: ' Today is Friday ' Monday Line1001: MyDay = Day(Now()) ' Number of this day fri = MyDay + 4 sat = MyDay + 5 If sat < 10 Then sat = Zero & sat If fri < 10 Then fri = Zero & fri GoTo Line1006: ' Tuesday Line1002: MyDay = Day(Now()) ' Number of this day fri = MyDay + 3 sat = MyDay + 4 If sat < 10 Then sat = Zero & sat If fri < 10 Then fri = Zero & fri GoTo Line1006: ' Wednesday Line1003: MyDay = Day(Now()) ' Number of this day fri = MyDay + 2 sat = MyDay + 3 If sat < 10 Then sat = Zero & sat If fri < 10 Then fri = Zero & fri GoTo Line1006: ' Thursday Line1004: MyDay = Day(Now()) ' Number of this day fri = MyDay + 1 sat = MyDay + 2 If sat < 10 Then sat = Zero & sat If fri < 10 Then fri = Zero & fri GoTo Line1006: ' Friday Line1005: MyDay = Day(Now()) ' Number of this day fri = MyDay sat = MyDay + 1 If fri < 10 Then fri = Zero & fri If sat < 10 Then sat = Zero & sat Line1006: " wrote: I've had to deal with the same issue with dates whithin a sheet since I work for an international company. Europeans like the YYMMDD format and Americans like the MMDDYY format. I don't want to try and understand your code but I'll give a few hinds for how I handled it: try something along these lines: sub formatDate(strDateFormat as string, strFileDirectory as string) dim mm, dd, yy as integer dim strFileName as string strFileName = dir(strFileDirectory) 'separate file name from directory if dateFormat = "YYMMDD" then yy = left(strFileName, 2) mm = right(left(strFileName, 4),2) dd = right(left(strFileName, 6),2) else mm = left(strFileName, 2) dd = right(left(strFileName, 4),2) yy = right(left(strFileName, 6),2) end if 'then do something with the separate variables, 'likely concatenate (with &) each variable in the appropriate format. end sub That's a quick and dirty, but I hope it'll help. Cheers! Nate |
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
I want Excel to determine the correct directory.
I thought I should share a solution to a small bug in my previous macro. The
code that I thought was complete ended up having a bug. If the Month or Year happens to be different between Today, Friday and Saturday, meaning the month or year changes within the week, then the value assignments for Friday, Saturday, Month and/or Year end up being wrong. For example, if I run the previous macro on Monday, March 31st, 2008, the value for the month of the coming Friday and Saturday get assigned 35 and 36, not 03 and 04, the 3rd and 4th of April. Same with the month and then even the year if you happen to run this macro in the last week of the year and the year is different between the day you run it and the year of the coming Friday and Saturday. I will post my new macro below. Dim FriMonth, SatMonth, FriYear, SatYear, Fri, Sat, Zero, MyWeekday Zero = 0 ' What day of the week is it today? MyWeekday = Weekday(Now(), 1) If MyWeekday = 2 Then GoTo Line1001: ' Today is Monday If MyWeekday = 3 Then GoTo Line1002: ' Today is Tuesday If MyWeekday = 4 Then GoTo Line1003: ' Today is Wednesday If MyWeekday = 5 Then GoTo Line1004: ' Today is Thursday If MyWeekday = 6 Then GoTo Line1005: ' Today is Friday Line1001: ' Monday Fri = Day(Now() + 4) ' Friday's Number Sat = Day(Now() + 5) ' Saturday's Number If Sat < 10 Then Sat = Zero & Sat If Fri < 10 Then Fri = Zero & Fri 'Month FriMonth = Month(Now() + 4) ' Friday's Month SatMonth = Month(Now() + 5) ' Saturday's Month If FriMonth < 10 Then FriMonth = Zero & FriMonth If SatMonth < 10 Then SatMonth = Zero & SatMonth ' Year FriYear = Right(Year(Now() + 4), 2) ' Friday's year SatYear = Right(Year(Now() + 5), 2) ' Saturday's year GoTo Line1006: Line1002: ' Tuesday Fri = Day(Now() + 3) ' Friday's Number Sat = Day(Now() + 4) ' Saturday's Number If Sat < 10 Then Sat = Zero & Sat If Fri < 10 Then Fri = Zero & Fri 'Month FriMonth = Month(Now() + 3) ' Friday's Month SatMonth = Month(Now() + 4) ' Saturday's Month If FriMonth < 10 Then FriMonth = Zero & FriMonth If SatMonth < 10 Then SatMonth = Zero & SatMonth ' Year FriYear = Right(Year(Now() + 3), 2) ' Friday's year SatYear = Right(Year(Now() + 4), 2) ' Saturday's year GoTo Line1006: Line1003: ' Wednesday Fri = Day(Now() + 2) ' Friday's Number Sat = Day(Now() + 3) ' Saturday's Number If Sat < 10 Then Sat = Zero & Sat If Fri < 10 Then Fri = Zero & Fri 'Month FriMonth = Month(Now() + 2) ' Friday's Month SatMonth = Month(Now() + 3) ' Saturday's Month If FriMonth < 10 Then FriMonth = Zero & FriMonth If SatMonth < 10 Then SatMonth = Zero & SatMonth ' Year FriYear = Right(Year(Now() + 2), 2) ' Friday's year SatYear = Right(Year(Now() + 3), 2) ' Saturday's year GoTo Line1006: Line1004: ' Thursday Fri = Day(Now() + 1) ' Friday's Number Sat = Day(Now() + 2) ' Saturday's Number If Sat < 10 Then Sat = Zero & Sat If Fri < 10 Then Fri = Zero & Fri 'Month FriMonth = Month(Now() + 1) ' Friday's Month SatMonth = Month(Now() + 2) ' Saturday's Month If FriMonth < 10 Then FriMonth = Zero & FriMonth If SatMonth < 10 Then SatMonth = Zero & SatMonth ' Year FriYear = Right(Year(Now() + 1), 2) ' Friday's year SatYear = Right(Year(Now() + 2), 2) ' Saturday's year GoTo Line1006: Line1005: ' Friday Fri = Day(Now()) ' Friday's Number Sat = Day(Now() + 1) ' Saturday's Number If Sat < 10 Then Sat = Zero & Sat If Fri < 10 Then Fri = Zero & Fri 'Month FriMonth = Month(Now()) ' Friday's Month SatMonth = Month(Now() + 1) ' Saturday's Month If FriMonth < 10 Then FriMonth = Zero & FriMonth If SatMonth < 10 Then SatMonth = Zero & SatMonth ' Year FriYear = Right(Year(Now()), 2) ' Friday's year SatYear = Right(Year(Now() + 1), 2) ' Saturday's year Line1006: ' Import this weeks Work Order & Wrap Work Order ChDir "\\fileserver\" & SatYear & SatMonth & Sat Workbooks.Open "\\FileServer\"&SatYear&SatMonth&Sat&"\P"&FriMonth &Fri&FriYear&".XLS") |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How to correct cannot access directory 'J:\\'. | Excel Discussion (Misc queries) | |||
How to determine if a Folder/Directory Exists in Excel VBA | Excel Programming | |||
How to determine the parent directory | Excel Programming | |||
Pointing to the Correct Directory | Excel Programming | |||
How does Excel determine the TEMP directory? | Excel Programming |