VBA/Excel/Access/Word/File Path/File — различия между версиями
Admin (обсуждение | вклад) м (1 версия) |
|
(нет различий)
|
Версия 16:33, 26 мая 2010
Содержание
- 1 Check file existance
- 2 Common File Operations Simplified
- 3 Does the specified file exist?
- 4 Gets the file name from the path.
- 5 List all files under application path
- 6 processes multiple stored files
- 7 Select a folder
- 8 Select a location containing the files you want to list
- 9 Use array to store a list of files
Check file existance
Sub ReadPersistedRecordset()
Dim strFileName As String
strFileName = "c:\test.txt"
If Len(Dir(strFileName)) = 0 Then
msgBox "File Not Found"
Exit Sub
End If
End Sub
Common File Operations Simplified
Sub TestGetFile()
Dim nIndex As Integer
Dim sFile As String
sFile = GetExcelFile("Testing GetExcelFile Function")
If sFile = "False" Then
Debug.Print "No file selected."
Exit Sub
End If
Debug.Print sFile
End Sub
Function GetExcelFile(sTitle As String) As String
Dim sFilter As String
Dim bMultiSelect As Boolean
sFilter = "Workbooks (*.xls), *.xls"
bMultiSelect = False
GetExcelFile = Application.GetOpenFilename(FileFilter:=sFilter, _
Title:=sTitle, MultiSelect:=bMultiSelect)
End Function
Does the specified file exist?
Function FileExists(stFile As String) As Boolean
If Dir(stFile) <> "" Then FileExists = True
End Function
Sub TestForFile()
Dim myFileName As String
myFileName = "c:\SalesData1.xls"
If FileExists(myFileName) Then
MsgBox myFileName & " exists"
Else
MsgBox myFileName & " does not exist"
End If
End Sub
Gets the file name from the path.
Sub GetFileName()
Dim stPathSep As String
Dim fileLength As Integer
Dim i As Integer
Dim stFullName As String
stFullName = "C:\asdf.xls"
stPathSep = Application.PathSeparator
fileLength = Len(stFullName)
For i = fileLength To 1 Step -1
If Mid(stFullName, i, 1) = stPathSep Then Exit For
Debug.Print Right(stFullName, fileLength - i + 1)
Next i
End Sub
List all files under application path
Sub FileList()
Dim File As Variant
With Application.FileSearch
.LookIn = "C:\"
.FileType = msoFileTypeAllFiles
.Execute
For Each File In .FoundFiles
MsgBox File
Next File
End With
End Sub
processes multiple stored files
Sub BatchProcess()
Dim Files() As String
Dim FileSpec As String
FileSpec = "c:\text.txt"
NewPath = ExtractPath(FileSpec)
FoundFile = Dir(FileSpec)
If FoundFile = "" Then
MsgBox "Cannot find file:" & FileSpec
Exit Sub
End If
FileCount = 1
ReDim Preserve Files(FileCount)
Files(FileCount) = FoundFile
Do While FoundFile <> ""
FoundFile = Dir()
If FoundFile <> "" Then
FileCount = FileCount + 1
ReDim Preserve Files(FileCount)
Files(FileCount) = FoundFile
End If
Loop
For I = 1 To FileCount
Application.StatusBar = "Processing " & Files(I)
Call ProcessFiles(Files(I))
Next I
Application.StatusBar = False
End Sub
Sub ProcessFiles(FileName As String)
Workbooks.OpenText FileName:=FileName, Origin:=xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(3, 1), Array(12, 1))
End Sub
Function ExtractPath(Spec As String) As String
SpecLen = Len(Spec)
For I = SpecLen To 1 Step -1
If Mid(Spec, I, 1) = "\" Then
ExtractPath = Left(Spec, I - 1)
Exit Function
End If
Next I
ExtractPath = ""
End Function
Select a folder
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Function GetDirectory() As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
bInfo.lpszTitle = "Select a folder."
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If
End Function
Sub GetAFolder()
Debug.Print GetDirectory()
End Sub
Select a location containing the files you want to list
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Sub ListFiles()
Msg = "Select a location containing the files you want to list."
Directory = GetDirectory(Msg)
If Directory = "" Then Exit Sub
If Right(Directory, 1) <> "\" Then Directory = Directory & "\"
On Error Resume Next
With Application.FileSearch
.NewSearch
.LookIn = Directory
.Filename = "*.*"
.SearchSubFolders = False
.Execute
For i = 1 To .FoundFiles.Count
Debug.Print .FoundFiles(i)
Debug.Print FileLen(.FoundFiles(i))
Debug.Print FileDateTime(.FoundFiles(i))
Next i
End With
End Sub
Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If
End Function
Use array to store a list of files
Sub XLFiles()
Dim FName As String
Dim arNames() As String
Dim myCount As Integer
FName = Dir("C:\*.xls*")
Do Until FName = ""
myCount = myCount + 1
ReDim Preserve arNames(1 To myCount)
arNames(myCount) = FName
FName = Dir
Loop
End Sub