View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
Gary Keramidas Gary Keramidas is offline
external usenet poster
 
Posts: 2,494
Default 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