寫了很多的Excel VBA的工具,但是檔案的選取都是利用輸入的方式,雖然這個的寫法對於有規則的檔案命名很方便,但是如果要處理的檔案檔名沒有規則時就很不方便,這支VBA會將您選取的多個檔案,顯示完整路徑,檔案含副檔名,或是只有檔案名稱,方便其它程式使用。
1.執行結果
檔案下載,請到[首頁右上方],[範例檔案下載],找到FileDialog.xls下載
或是copy底下網址在網址輸入處貼上
程式碼如下:
Private Sub cmdPickFileDialog_Click() Dim fd As FileDialog '宣告一個檔案對話框 Set fd = Excel.Application.FileDialog(msoFileDialogFilePicker) '設定選取檔案功能 fd.Filters.Clear '清除之前的資料 fd.Filters.Add "Excel File", "*.xls*" '設定顯示的副檔名 fd.Filters.Add "Word File", "*.doc*" fd.Filters.Add "所有檔案", "*.*" fd.Show '顯示對話框 Sheet1.Columns("A:D").Clear '將舊的A-D欄資料清除 For i = 1 To fd.SelectedItems.Count strFullName = fd.SelectedItems(i) Sheet1.Cells(i, 1) = strFullName '顯示所選取的檔案名稱 n = rinstr(strFullName, "\") strFileNameType = Mid(strFullName, n + 1) Sheet1.Cells(i, 2) = strFileNameType n = InStr(1, strFileNameType, ".") strFileName = Left(strFileNameType, n - 1) strsFileType = Mid(strFileNameType, n + 1) Sheet1.Cells(i, 3) = strFileName Sheet1.Cells(i, 4) = strsFileType Next End Sub Function rinstr(ByVal t As String, ByVal s As String) '自訂函數找尋某個字串最後出現的位置 Dim i As Integer Dim n As Integer n = 0 For i = 1 To Len(t) If Mid(t, i, 1) = s Then n = i End If Next rinstr = n End Function
- 本文固定链接: http://wordpress.bestdaylong.com/blog/archives/910
- 转载请注明: 明和 蔡 于 彰化一整天blog 发表