Macro - Need location of XLS itself to be set as default
 

Below is a macro that I now have working. The text file I'm trying to select
will always be in the same directory as the XLS itself. What I'm hoping to do
is rather than have a hard coded in as "H:\XLS", I'd like to symbolic this
directory to the same as the XLS. Is there a variable I can use that knows
what directory the XLS is running out of and is there a way to use it below?
thanks in advance for your help

=================
Sub ImportProgramData()

Dim file_name As Variant

Range("A3:G300").Select
Selection.ClearContents

Application.DefaultFilePath = "H:\XLS" 'Set default file path to root
file_name = Application.GetOpenFilename

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & file_name _
, Destination:=Range("A3:G300"))
..Name = "ImportProgramData"
..FieldNames = True
..RowNumbers = False
..FillAdjacentFormulas = False
..PreserveFormatting = True
..RefreshOnFileOpen = False
..RefreshStyle = xlInsertDeleteCells
..SavePassword = False
..SaveData = True
..AdjustColumnWidth = True
..RefreshPeriod = 0
..TextFilePromptOnRefresh = False
..TextFilePlatform = 437
..TextFileStartRow = 1
..TextFileParseType = xlDelimited
..TextFileTextQualifier = xlTextQualifierDoubleQuote
..TextFileConsecutiveDelimiter = False
..TextFileTabDelimiter = True
..TextFileSemicolonDelimiter = False
..TextFileCommaDelimiter = False
..TextFileSpaceDelimiter = False
..TextFileOtherDelimiter = "|"
..TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
..TextFileTrailingMinusNumbers = True
..Refresh BackgroundQuery:=False

End With
ActiveWorkbook.Save

End Sub
=============================

Macro - Need location of XLS itself to be set as default
 

Hi CRayF

You can use
ActiveWorkbook.Path



--
Regards Ron de Bruin
http://www.rondebruin.nl


"CRayF" wrote in message ...
Below is a macro that I now have working. The text file I'm trying to select
will always be in the same directory as the XLS itself. What I'm hoping to do
is rather than have a hard coded in as "H:\XLS", I'd like to symbolic this
directory to the same as the XLS. Is there a variable I can use that knows
what directory the XLS is running out of and is there a way to use it below?
thanks in advance for your help

=================
Sub ImportProgramData()

Dim file_name As Variant

Range("A3:G300").Select
Selection.ClearContents

Application.DefaultFilePath = "H:\XLS" 'Set default file path to root
file_name = Application.GetOpenFilename

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & file_name _
, Destination:=Range("A3:G300"))
.Name = "ImportProgramData"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False

End With
ActiveWorkbook.Save

End Sub
=============================

Macro - Need location of XLS itself to be set as default
 

ThisWorkbook.Path gives the path to the current workbook's file.
--
- K Dales


"CRayF" wrote:

Below is a macro that I now have working. The text file I'm trying to select
will always be in the same directory as the XLS itself. What I'm hoping to do
is rather than have a hard coded in as "H:\XLS", I'd like to symbolic this
directory to the same as the XLS. Is there a variable I can use that knows
what directory the XLS is running out of and is there a way to use it below?
thanks in advance for your help

=================
Sub ImportProgramData()

Dim file_name As Variant

Range("A3:G300").Select
Selection.ClearContents

Application.DefaultFilePath = "H:\XLS" 'Set default file path to root
file_name = Application.GetOpenFilename

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & file_name _
, Destination:=Range("A3:G300"))
.Name = "ImportProgramData"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False

End With
ActiveWorkbook.Save

End Sub
=============================

Macro - Need location of XLS itself to be set as default
 

just a question:

doesn't it always look in the path the xl sheet is in for a file? i didn't
think you would have to explicitly define the path when it's in the same
folder.Other than for coding correctness)

i thought it looked in the default path and then the path the excel file is
in, then if it doesn't find it, it gives an error.

just wondering. because i don't know for sure

--


Gary


"Ron de Bruin" wrote in message
...
Hi CRayF

You can use
ActiveWorkbook.Path



--
Regards Ron de Bruin
http://www.rondebruin.nl


"CRayF" wrote in message
...
Below is a macro that I now have working. The text file I'm trying to
select
will always be in the same directory as the XLS itself. What I'm hoping
to do
is rather than have a hard coded in as "H:\XLS", I'd like to symbolic
this
directory to the same as the XLS. Is there a variable I can use that
knows
what directory the XLS is running out of and is there a way to use it
below?
thanks in advance for your help

=================
Sub ImportProgramData()

Dim file_name As Variant

Range("A3:G300").Select
Selection.ClearContents

Application.DefaultFilePath = "H:\XLS" 'Set default file path to root
file_name = Application.GetOpenFilename

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & file_name _
, Destination:=Range("A3:G300"))
.Name = "ImportProgramData"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False

End With
ActiveWorkbook.Save

End Sub
=============================

Macro - Need location of XLS itself to be set as default
 

Hi Gary

Application.GetOpenFilename will use the default folder

You can change it like this and turn it back at the end of the macro
Here a small example

Sub test()
Dim FName As Variant
Dim wb As Workbook
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir

MyPath = ThisWorkbook.Path
ChDrive MyPath
ChDir MyPath

FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls")
If FName < False Then
Set wb = Workbooks.Open(FName)
MsgBox "your code"
wb.Close
End If

ChDrive SaveDriveDir
ChDir SaveDriveDir

End Sub


--
Regards Ron de Bruin
http://www.rondebruin.nl


"Gary Keramidas" wrote in message ...
just a question:

doesn't it always look in the path the xl sheet is in for a file? i didn't think you would have to explicitly define the path when
it's in the same folder.Other than for coding correctness)

i thought it looked in the default path and then the path the excel file is in, then if it doesn't find it, it gives an error.

just wondering. because i don't know for sure

--


Gary


"Ron de Bruin" wrote in message ...
Hi CRayF

You can use
ActiveWorkbook.Path



--
Regards Ron de Bruin
http://www.rondebruin.nl


"CRayF" wrote in message ...
Below is a macro that I now have working. The text file I'm trying to select
will always be in the same directory as the XLS itself. What I'm hoping to do
is rather than have a hard coded in as "H:\XLS", I'd like to symbolic this
directory to the same as the XLS. Is there a variable I can use that knows
what directory the XLS is running out of and is there a way to use it below?
thanks in advance for your help

=================
Sub ImportProgramData()

Dim file_name As Variant

Range("A3:G300").Select
Selection.ClearContents

Application.DefaultFilePath = "H:\XLS" 'Set default file path to root
file_name = Application.GetOpenFilename

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & file_name _
, Destination:=Range("A3:G300"))
.Name = "ImportProgramData"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False

End With
ActiveWorkbook.Save

End Sub
=============================

Macro - Need location of XLS itself to be set as default
 

Thanks guys, Sorry, new at trying this stuff. I tried both ThisWorkbook.Path
and ActiveWorkbook.Path. Also, it would also be nice not to be prompted for
the Directory. Rather, when I run the macro I would like it to automatically
import the example.TXT
So what should the:
file_name = Application.GetOpenFilename
statement look like in order to acquire the file €œexample.txt€� file from the
same directory where the XLS is run rather than the last on saved.

Here is a little more detail on what happened when I tried ThisWorkbook.Path
and ActiveWorkbook.Path. Both the XLS and the *.TXT file will ALWAYS be
located in the same directory. Currently it is in H:\XLS. I want to be able
to make a copy of these 2 files in say D:\XLS-Other and when the macro runs I
want it to default to the same location of the XLS I opened. Both
ThisWorkbook.Path and ActiveWorkbook.Path seem to default to the last
directory that was called from. i.e. When I run the H:\XLS\example.xls all
works fine. I then copy the XLS and TXT files to a different directory
€œD:\XLS-Other€� and start it there. It now defaults to the old H\XLS
directory. If I now BROWSE and find the local D:\XLS-Other\example.TXT file,
save and then copy the 2 files back to the original H\XLS directory and open
the new XLS copy in H:\XLS directory, it points back to the D:\XLS-Other
directory. It's as if the macro is calling the "Last Directory Used" instead.
Any clues...


"CRayF" wrote:

=================
Sub ImportProgramData()

Dim file_name As Variant

Range("A3:G300").Select
Selection.ClearContents

Application.DefaultFilePath = ThisWorkbook.Path 'Set default file path to root
file_name = Application.GetOpenFilename

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & file_name _
, Destination:=Range("A3:G300"))
..Name = "ImportProgramData"
..FieldNames = True
..RowNumbers = False
..FillAdjacentFormulas = False
..PreserveFormatting = True
..RefreshOnFileOpen = False
..RefreshStyle = xlInsertDeleteCells
..SavePassword = False
..SaveData = True
..AdjustColumnWidth = True
..RefreshPeriod = 0
..TextFilePromptOnRefresh = False
..TextFilePlatform = 437
..TextFileStartRow = 1
..TextFileParseType = xlDelimited
..TextFileTextQualifier = xlTextQualifierDoubleQuote
..TextFileConsecutiveDelimiter = False
..TextFileTabDelimiter = True
..TextFileSemicolonDelimiter = False
..TextFileCommaDelimiter = False
..TextFileSpaceDelimiter = False
..TextFileOtherDelimiter = "|"
..TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
..TextFileTrailingMinusNumbers = True
..Refresh BackgroundQuery:=False

End With
ActiveWorkbook.Save

End Sub

Macro - Need location of XLS itself to be set as default
 

sorry guys..
I am not sure what I tested (several times) but it was certainly user
error... I just know what...

When augmenting the statements to achieve not being prompted... and
retesting... It now loads the example.txt from the correct directory now.
wack wack, scratch scratch... oh well, once again, thanks for the variable...
All complete...

Changed:
Application.DefaultFilePath = ThisWorkbook.Path
file_name = Application.GetOpenFilename

To:
file_name = ThisWorkbook.Path & "\example.txt"

Macro - Need location of XLS itself to be set as default
 

Hi Ron, It seems like when I select the B2 cell this routins still opens up
the target file directory to the last one used before positioned below. I am
hoping for it to open up the sub-rectory "\RaceData-XLS-Ready"
Any clues?
Here is the code:
-------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim srcProgramDataInputWs As Worksheet
Dim srcProgramSummaryTemplateWs As Worksheet
Dim srcProgramSummaryWs As Worksheet
Dim srcBettingTemplateWs As Worksheet
Dim racePark As Variant
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim wb As Workbook
Dim MyPath As String
Dim SaveDriveDir As String


Set srcProgramSummaryTemplateWs = Sheets("@TemplateProgramSummary")
Set srcProgramSummaryWs = Sheets("ProgramSummary")
Set srcBettingTemplateWs = Sheets("@TempleteBetting")
Set srcProgramDataInputWs = Sheets("ProgramDataInput")

racePark = Left(srcProgramDataInputWs.Range("H3").Value, 3)

If Target.Address = "$A$1" Then
Dim exists As Boolean
Dim ExistingBettingWsName As Worksheet
Dim NewBettingWsName As Variant

SaveDriveDir = CurDir
MyPath = ThisWorkbook.Path & "/RaceData-XLS-Ready"
ChDrive MyPath
ChDir MyPath

Range("N3").Select

NewBettingWsName = Format(srcProgramDataInputWs. _
Range("F3").Value, "mm-dd ") & _
Left(srcProgramDataInputWs.Range("H3").Value, 3)

exists = False
For Each ExistingBettingWsName In ThisWorkbook.Sheets
If ExistingBettingWsName.Name = NewBettingWsName Then
exists = True
Exit For
End If
Next
If exists Then
MsgBox "Betting Worksheet for [ " & NewBettingWsName & _
" ] already exists. [RENAME] or [DELETE] that Worksheet and try
again."

Else
Dim NewBettingWs As Worksheet
Dim NewBettingWsTabColor As Variant
Dim raceParkList As Variant
Dim src As Variant

i = 6
raceParkList = srcProgramDataInputWs.Range("N" & i).Value
Do Until raceParkList = ""
raceParkList = srcProgramDataInputWs.Range("N" & i).Value
If racePark = raceParkList Then NewBettingWsTabColor =
srcProgramDataInputWs.Range("O" & i).Value
i = i + 1
Loop

Range("N3").Select

srcBettingTemplateWs.Copy befo=ActiveSheet
Set NewBettingWs = ActiveSheet
With NewBettingWs
.Name = NewBettingWsName
.Unprotect
.Tab.ColorIndex = NewBettingWsTabColor 'or replace with
index number

src = srcProgramDataInputWs.Range("B3").Value
i = 3
j = 0
Do Until src = ""
srcBettingTemplateWs.Rows("11:22").Copy .Cells((j * 12)
+ 11, 1)
i = i + 12
j = j + 1
src = srcProgramDataInputWs.Cells(i, 2).Value
Loop

.Protect
End With
End If
ChDrive SaveDriveDir
ChDir SaveDriveDir
End If


If Target.Address = "$E$1" Then
If MsgBox("Are you sure you want to CLEAR this Worksheet?", _
vbYesNo) = vbYes Then
ActiveSheet.Unprotect
ActiveSheet.Range("N3:Q242").Formula = _
srcProgramSummaryTemplateWs.Range("N3:Q242").Formu la
ActiveSheet.Protect
Range("K1").Value = "default"
Range("N3").Select
End If
End If


If Target.Address = "$B$1" Then
Dim SelectedTxtInputFile As Variant
SelectedTxtInputFile = Application.GetOpenFilename( _
"Race Program Input Files (*.txt),*.txt", , _
"Select which RACE Program to import", , False)

If SelectedTxtInputFile = "False" Then
'Range("N3").Select
Else

srcProgramDataInputWs.Unprotect
srcProgramDataInputWs.Range("A3:H242").ClearConten ts

With srcProgramDataInputWs.QueryTables.Add(Connection:= _
"TEXT;" & SelectedTxtInputFile _
, Destination:=srcProgramDataInputWs.Range("A3:H242" ))
.Name = "ImportProgramData"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
srcProgramDataInputWs.Protect
End If
Range("N3").Select
End If

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo ws_exit:
Application.EnableEvents = False
'add your code here
Range("K1").Value = "Clear"
ws_exit:
Application.EnableEvents = True
End Sub