1 2 3 4 5 6

廣告

網友您好,若是您覺得我寫的工具或文章對您有幫助,
而您或者您的朋友有在博客來購物,可以透過底下連結

如何在博客來購物贊助網站或是點選計數器下方的博客來圖示來讓網站可以永續經營。

2012年2月21日 星期二

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

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


程式碼如下:

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

沒有留言:

贊助

彰化一整天粉絲團