VBA/Excel/Access/Word/File Path/File — различия между версиями
Admin (обсуждение | вклад) м (1 версия) |
|
(нет различий)
|
Текущая версия на 15:47, 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
<source lang="vb">
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
</source>
Common File Operations Simplified
<source lang="vb">
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
</source>
Does the specified file exist?
<source lang="vb">
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
</source>
Gets the file name from the path.
<source lang="vb">
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
</source>
List all files under application path
<source lang="vb">
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
</source>
processes multiple stored files
<source lang="vb">
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
</source>
Select a folder
<source lang="vb">
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
</source>
Select a location containing the files you want to list
<source lang="vb">
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
</source>
Use array to store a list of files
<source lang="vb">
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
</source>