Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 22
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 644
Default 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
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Change file names in a folder TISR Excel Programming 2 April 12th 06 01:35 PM
Need code to save file to new folder, erase from old folder Ron M. Excel Discussion (Misc queries) 1 February 24th 06 06:02 PM
open folder _open file code? Ella[_2_] Excel Programming 0 September 12th 05 06:17 PM
macro code to change file-opening password arunjoshi[_18_] Excel Programming 1 June 16th 05 08:49 AM
prevent user from saving file to a folder but allow my code to save from behind. susie Excel Programming 3 July 25th 03 03:01 PM


All times are GMT +1. The time now is 06:33 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"