如何選取多個檔案名稱並存入Excel活頁中

如何選取多個檔案名稱並存入Excel活頁中(查看次數:1233)

回首頁

2012-02-21 22:02:39
寫了很多的Excel VBA的工具,但是檔案的選取都是利用輸入的方式,雖然這個的寫法對於有規則的檔案命名很方便,但是如果要處理的檔案檔名沒有規則時就很不方便,這支VBA會將您選取的多個檔案,顯示完整路徑,檔案含副檔名,或是只有檔案名稱,方便其它程式使用。

 


1.執行結果

 

檔案下載,請到[首頁右上方],[範例檔案下載],找到FileDialog.xls下載

或是copy底下網址在網址輸入處貼上



 

http://sites.google.com/site/272586/fan-li-cheng-shi/FileDialog.xls?attredirects=0&d=1

 

程式碼如下:

 

[vb]
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
[/vb]

如何選取多個檔案名稱並存入Excel活頁中
上一篇:wordpress之shopperpress 付款方式新增程式(tmh_other_01.php)(667)      下一篇:test(5)