Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Change Code in Macro to specify file/folder to look in.
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 he " & XLSFileName 'Delete the bat and text file you have create Kill BatFileName Kill TXTFileName Application.ScreenUpdating = True End If End Sub ' End code |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Change Code in Macro to specify file/folder to look in.
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 Dtown Dawg wrote: 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 he " & XLSFileName 'Delete the bat and text file you have create Kill BatFileName Kill TXTFileName Application.ScreenUpdating = True End If End Sub ' End code |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Change file names in a folder | Excel Programming | |||
Need code to save file to new folder, erase from old folder | Excel Discussion (Misc queries) | |||
open folder _open file code? | Excel Programming | |||
macro code to change file-opening password | Excel Programming | |||
prevent user from saving file to a folder but allow my code to save from behind. | Excel Programming |