I want Excel to determine the correct directory.

[Don M.]

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\PublicationOrdering\080308

and a file named

\\FileServer\Data\Global\Programs\PublicationOrdering\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\PublicationOrdering\YYMMDD"
' Open WMT Work Order
Workbooks.Open Filename:= _

"\\FileServer\Data\Global\Programs\PublicationOrdering\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("C2762").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\PublicationOrdering\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("C2762").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\PublicationOrdering\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("C2762").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=Share Deny W" _
, _
"rite;Extended Properties="""";Jet OLEDB:System database="""";Jet
OLEDB:Registry Path="""";Jet OLEDBatabase Password="""";Jet OLEDB:Eng" _
, _
"ine Type=4;Jet OLEDBatabase 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 OLEDBon'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=Share Deny W" _
, _
"rite;Extended Properties="""";Jet OLEDB:System database="""";Jet
OLEDB:Registry Path="""";Jet OLEDBatabase Password="""";Jet OLEDB:Eng" _
, _
"ine Type=4;Jet OLEDBatabase 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 OLEDBon'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=Share Deny W" _
, _
"rite;Extended Properties="""";Jet OLEDB:System database="""";Jet
OLEDB:Registry Path="""";Jet OLEDBatabase Password="""";Jet OLEDB:Eng" _
, _
"ine Type=4;Jet OLEDBatabase 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 OLEDBon'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=Share Deny W" _
, _
"rite;Extended Properties="""";Jet OLEDB:System database="""";Jet
OLEDB:Registry Path="""";Jet OLEDBatabase Password="""";Jet OLEDB:Eng" _
, _
"ine Type=4;Jet OLEDBatabase 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 OLEDBon'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=Share Deny W" _
, _
"rite;Extended Properties="""";Jet OLEDB:System database="""";Jet
OLEDB:Registry Path="""";Jet OLEDBatabase Password="""";Jet OLEDB:Eng" _
, _
"ine Type=4;Jet OLEDBatabase 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 OLEDBon'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=Share Deny W" _
, _
"rite;Extended Properties="""";Jet OLEDB:System database="""";Jet
OLEDB:Registry Path="""";Jet OLEDBatabase Password="""";Jet OLEDB:Eng" _
, _
"ine Type=4;Jet OLEDBatabase 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 OLEDBon'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

 

[turbonate]

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

 

[Gary Keramidas]

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\PublicationOrdering\" & dstr(0);
dstr(1); dstr(2)
ElseIf Weekday(Range("A1"), 1) = 7 Then
Debug.Print "\\fileserver\data\Global\Programs\PublicationOrdering\" & dstr(2);
dstr(0); dstr(1)
End If
End Sub

 

[Gary Keramidas]

and make sure lines beginning with debug are all on the same line, because oe
wordwraps it:

Debug.Print "\\fileserver\data\Global\Programs\PublicationOrdering\" & dstr(2);
dstr(0); dstr(1)

 

[Don M.]

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]

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\PublicationOrdering\"
Set wb2 = Workbooks.Open(fPath & "MWE_" & fName & ".xls")
End Sub

 

[Don M.]

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\PublicationOrdering\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\PublicationOrdering\"&yy&mm&sat&"\P___"&mm&fri&yy&".XLS"

Does something like that look like I'm on the right path?

Don

 

[Gary Keramidas]

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\PublicationOrdering\" & _
Range("H1").Value & "\"
fName = Range("H2").Value & ".xls"
Set wb2 = Workbooks.Open(fPath & "MWE_" & fName & ".xls")

End Sub

 

[Don M.]

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

 

[Don M.]

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:

 

[Don M.]

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")