Change Code in Macro to specify file/folder to look in.

D

Dtown Dawg

I have a macro that when run, will prompt me to select the folder and file my
information is in. However the information will always be in this location.
How can I change my code so when it is run, it will automatically look in
that folder and file for the information instead of prompting me. Here is
the code:

' Start Code

Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long

Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, _
lpExitCode As Long) As Long

Public Const PROCESS_QUERY_INFORMATION = &H400
Public Const STILL_ACTIVE = &H103


Public Sub ShellAndWait(ByVal PathName As String, Optional WindowState)
Dim hProg As Long
Dim hProcess As Long, ExitCode As Long
'fill in the missing parameter and execute the program
If IsMissing(WindowState) Then WindowState = 1
hProg = Shell(PathName, WindowState)
'hProg is a "process ID under Win32. To get the process handle:
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg)
Do
'populate Exitcode variable
GetExitCodeProcess hProcess, ExitCode
DoEvents
Loop While ExitCode = STILL_ACTIVE
End Sub


Sub Merge_CSV_Files()
Dim BatFileName As String
Dim TXTFileName As String
Dim XLSFileName As String
Dim DefPath As String
Dim Wb As Workbook
Dim oApp As Object
Dim oFolder
Dim foldername

'Create two temporary file names
BatFileName = Environ("Temp") & "\CollectCSVData" & Format(Now,
"dd-mm-yy-h-mm-ss") & ".bat"
TXTFileName = Environ("Temp") & "\AllCSV" & Format(Now,
"dd-mm-yy-h-mm-ss") & ".txt"

' Create path to xls file
DefPath = "C:\Documents and Settings\dmobley\Desktop\JunkFolder\TESTEXCEL"
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If
XLSFileName = DefPath & "MasterSystemInfo " & Format(Now, "dd-mm-yy
h-mm-ss") & ".xls"

'Browse to the folder with CSV files
Set oApp = CreateObject("Shell.Application")
Set oFolder = oApp.BrowseForFolder(0, "Select folder with CSV files", 512)
If Not oFolder Is Nothing Then
foldername = oFolder.Self.Path
If Right(foldername, 1) <> "\" Then
foldername = foldername & "\"
End If

'Create the bat file
Open BatFileName For Output As #1
Print #1, "Copy " & Chr(34) & foldername & "*systeminfo.csv" &
Chr(34) & " " & TXTFileName
Close #1

'Run the Bat file to collect all data from the CSV files into a TXT
file
ShellAndWait BatFileName, 0
If Dir(TXTFileName) = "" Then
MsgBox "There are no csv files in this folder"
Kill BatFileName
Exit Sub
End If

'Open the TXT file in Excel
Application.ScreenUpdating = False
Workbooks.OpenText Filename:=TXTFileName, Origin:=xlWindows,
StartRow _
:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False,
Comma:=True, _
Space:=False, Other:=False

'Save text file as a XLS file
Set Wb = ActiveWorkbook
Application.DisplayAlerts = False
Wb.SaveAs Filename:=XLSFileName, FileFormat:=xlWorkbookNormal
Application.DisplayAlerts = True

Wb.Close savechanges:=False
MsgBox "You find the XLS file here: " & XLSFileName

'Delete the bat and text file you have create
Kill BatFileName
Kill TXTFileName

Application.ScreenUpdating = True
End If
End Sub
' End code
 
D

Die_Another_Day

This is my method for opening files. I sure there are better ways out
there though.
First I have a custom type to return the info:

Public Type FileProperties
SFile As String
SvLoc As String
Cancelled As Boolean
End Type

Then I have a function to grab the file:

Function OpenSesame(ClFilters As Boolean, OTitle As String, _
MultiSelect As Boolean, Optional Fltr As String, Optional FltrName
As String, _
Optional StartFolder As String) As FileProperties

OpenSesame.SFile = Empty
OpenSesame.SvLoc = Empty
OpenSesame.Cancelled = False

With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = MultiSelect
If Not IsEmpty(OTitle) Then .Title = OTitle
If Not IsEmpty(StartFolder) Then .InitialFileName = StartFolder
If ClFilters = True Then .Filters.Clear
If Not Fltr = "" Then
If Not FltrName = "" Then
.Filters.Add FltrName, Fltr
Else
.Filters.Add "User Filter", Fltr
End If
.FilterIndex = .Filters.Count
End If
If .Show = True Then
OpenSesame.SFile = .SelectedItems(1)
OpenSesame.SvLoc = .InitialFileName
Else
OpenSesame.Cancelled = True
End If
End With

End Function

Then I call the function from my sub:

Sub TestFolderOpen()
Dim Test As FileProperties
Test = OpenSesame(True, "Testing", False, "*.CSV", "CSV Files",
"C:\Temp\")
MsgBox Test.Cancelled & vbCrLf & Test.SFile & vbCrLf & Test.SvLoc
End Sub

This allows me to detected the user clicking cancel.
If Test.Cancelled Then Exit Sub

Anyhow I'm not sure if that helps or not so let me know if you need
more specific help

Die_Another_Day
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top