Chương 5: Thao tác với file

5.1 Select folder
5.2 Thao tác với file trong folder
5.3 Tạo temporary file
5.4 Tìm kiếm file
5.5 Lấy phần mở rộng
(Danh mục trên có thể được sửa lại sau khi bản dịch được hoàn thành)
 

tuhocvba

Administrator
Thành viên BQT
5.1 Chỉ định hộp thoại tham chiếu chọn Folder
Để hiển thị hộp thoại chọn Folder ta tham khảo hai dòng code dưới đây.
Mã:
rc = Application.Dialogs(xlDialogOpen).Show '(1)
rc =Application.GetOpenFilename("Microsoft Excel file, *xls") '(2)
Kết quả chạy dòng code (1) ta được:
Bạn cần đăng nhập để thấy đính kèm


Và đây là kết quả chạy dòng code (2)
Bạn cần đăng nhập để thấy đính kèm


Dòng code (2) không thực hiện việc mở file, tuy nhiên nó sẽ giúp chúng ta lấy đường link của file và cất vào biến rc. Sau đó chúng ta sẽ thao tác với file đó thông qua đường link lấy được.
 
Ta hãy xem xét ví dụ sau:
Mã:
Sub vidu()
strOldFile = Application.GetOpenFilename _
    (FileFilter:="All file(*.*),*.*", _
    Title:="tuhocvba.net")
End Sub
Chương trình trên sẽ hiển thị hộp thoại Dialog để người dùng chọn file, hộp thoại này sẽ có dòng tiêu đề là "tuhocvba.net".
Việc chọn file thì như thế rồi. Nhưng chọn folder thì VBA lại không làm được. Do đó ta sẽ sử dụng hàm API để thực hiện việc chọn folder.
Khi sử dụng hàm SHBrowserForFolder ta sẽ có như hình dưới đây:
Bạn cần đăng nhập để thấy hình ảnh

Con trỏ trả về của hàm SHBrowserForFolder sẽ được trao cho SHGetPathFromDList.
Khi đó t có thể lấy được tên Folder mà người dùng đã select.
Cuối cùng hàm CoTaskMemFree sẽ giải phóng bộ nhớ, toàn bộ xử lý là xong.
Nào, bây giờ ta sẽ xem chương trình mẫu Win 64 API.
Mã:
'----------------------------------------------------------------------
'クラス名またはキャプションからウィンドウハンドルを取得する関数
'
'戻り値     成功 = ウィンドウハンドル
'           失敗 = NULL
'----------------------------------------------------------------------
Declare PtrSafe Function FindWindow Lib "user32" _
    Alias "FindWindowA" _
    (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As LongPtr


'=================================================================================================================================
'----------------------------------------------------------------------
'フォルダ選択用のディレクトリツリーを表示する関数
'
'戻り値     成功 = 選択されたフォルダをルートとするITEMIDリストへのポインタ
'           キャンセル = 0
'----------------------------------------------------------------------
Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" _
    Alias "SHBrowseForFolderA" _
    (lpbi As BROWSEINFO) As LongPtr


'ダイアログボックスを初期化する情報を格納した構造体
Type BROWSEINFO
   hwndOwner As Long        'ダイアログボックスの親ウィンドウのハンドル
   pidlRoot As Long         'ルートフォルダ
   pszDisplayName As String 'ユーザーが選択したフォルダ名
   lpszTitle As String      'ダイアログボックスに表示するメッセージ
   ulFlags As Long          '動作方法を指定する
   lpfn As Long             'コールバック関数へのポインタ
   lParam As Long           'コールバック関数へのパラメータ
   iImage As Long           'フォルダ用アイコンのシステムイメージリストのID
End Type

'ルートフォルダを指定する定数
Public Const CSIDL_DESKTOP = &H0&           'デスクトップ
Public Const CSIDL_PROGRAMS = &H2&          'Windows\プログラム
Public Const CSIDL_CONTROLS = &H3&          'コントロールパネル
Public Const CSIDL_PRINTERS = &H4&          'プリンタ
Public Const CSIDL_PERSONAL = &H5&          'My Documents
Public Const CSIDL_FAVORITES = &H6&         'Favorities
Public Const CSIDL_STARTUP = &H7&           'スタートアップ
Public Const CSIDL_RECENT = &H8&            '最近使ったファイル
Public Const CSIDL_SENDTO = &H9&            '送る
Public Const CSIDL_BITBUCKET = &HA&         'ごみ箱
Public Const CSIDL_STARTMENU = &HB&         'スタートメニュー
Public Const CSIDL_DESKTOPDIRECTORY = &H10& 'Windows\デスクトップ
Public Const CSIDL_DRIVES = &H11&           'マイコンピュータ
Public Const CSIDL_NETWORK = &H12&          'ネットワーク
Public Const CSIDL_NETHOO = &H13&           'Windows\NetHood
Public Const CSIDL_FONTS = &H14&            'Windows\Fonts
Public Const CSIDL_TEMPLATES = &H15&        'Windows\ShellNew

'動作方法を指定する定数
Public Const BIF_RETURNONLYFSDIRS = &H1&        'ディレクトリの選択のみ可能
Public Const BIF_DONTGOBELOWDOMAIN = &H2&       'ネットワークフォルダを含まない
Public Const BIF_STATUSTEXT = &H4&              'ダイアログボックスにステータス表示領域を追加する
Public Const BIF_RETURNFSANCESTORS = &H8&       '親ディレクトリのみを選択可能にする
Public Const BIF_EDITBOX = &H10&                'ダイアログボックス内にアイテム名入力用のテキストボックスを追加する
Public Const BIF_VALIDATE = &H20&               '無効なアイテム名が入力されたときBroeseCallbackProcコールバック関数を呼び出す
Public Const BIF_BROWSEFORCOMPUTER = &H1000&    'コンピュータフォルダのみ選択可能
Public Const BIF_BROWSEFORPRINTER = &H2000&     'プリンタフォルダのみ選択可能
Public Const BIF_BROWSEINCLUDEFILES = &H4000&   'ファイルも表示する

Public Const MAX_PATH = 260                 'フォルダ名の最大長
'=================================================================================================================================


'----------------------------------------------------------------------
'SHBrowseForFolderで取得した値からフォルダのフルパスを取得する関数
'
'戻り値     成功 = NOERROR(=0)
'           失敗 = E_INVALIDARG(=&H80070057)
'----------------------------------------------------------------------
Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" _
    Alias "SHGetPathFromIDListA" _
    (ByVal pidl As Long, _
    ByVal pszPath As String) As LongPtr


'----------------------------------------------------------------------
'OLEアロケータによって確保したメモリブロックを開放する関数
'
'戻り値     なし
'----------------------------------------------------------------------
Declare PtrSafe Function CoTaskMemFree Lib "OLE32.dll" _
    (ByVal pv As Long) As LongPtr



'=================================================================================================================================
'----------------------------------------
'ファイル操作(コピー、移動、削除)を行う関数
'
'戻り値     成功 = 0
'           失敗 = 0以外
'-----------------------------------------
Declare PtrSafe Function SHFileOperation Lib "shell32.dll" _
    Alias "SHFileOperationA" _
    (lpFileOp As SHFILEOPSTRUCT) As LongPtr

'動作方法を指定する構造体
Type SHFILEOPSTRUCT
    hwnd As Long                    'ダイアログボックスの親ウィンドウのハンドル
    wFunc As Long                   '操作内容を指定する
    pFrom As String                 '操作元のファイル名、ディレクトリ名
    pTo As String                   '操作先のファイル名、ディレクトリ名
    fFlags As Integer               '操作内容を指定する
    fAnyOperationsAborted As Long   '処理終了前にキャンセルしたときは「1」
    hNameMappings As Long           'ファイルネームマッピングオブジェクト
    lpszProgressTitle As String     'ダイアログボックスのキャプション
End Type

'操作内容を指定する定数
Public Const FO_MOVE = &H1&         '移動
Public Const FO_COPY = &H2&         'コピー
Public Const FO_DELETE = &H3&       '削除
Public Const FO_RENAME = &H4&       '名前を変更

'動作方法指定する定数
Public Const FOF_MULTIDESTFILES = &H1&      '複数の異なるディレクトリを指定する
Public Const FOF_CONFIRMMOUSE = &H2&        '(使用不可)
Public Const FOF_SILENT = &H4&              'プログレスバーを表示しない
Public Const FOF_RENAMEONCOLLISION = &H8&   '重複名を避ける
Public Const FOF_NOCONFIRMATION = &H10&     '確認なし
Public Const FOF_WANTMAPPINGHANDLE = &H20&  'FOF_RENAMEONCOLLISIONを設定したときhNameMappingsにファイル名を指定する
Public Const FOF_ALLOWUNDO = &H40&          'ごみ箱へ
Public Const FOF_FILESONLY = &H80&          'ワイルドカードを使うのでディレクトリを含まない
Public Const FOF_SIMPLEPROGRESS = &H100&    'プログレスバーは表示するがファイル名は表示しない
Public Const FOF_NOCONFIRMMKDIR = &H200&    'ディレクトリ作成時に確認なし
Public Const FOF_NOERRORUI = &H400&         'エラーが発生してもダイアログボックスを表示しない
Mã:
'*****************************************
'フォルダ選択用のディレクトリツリーを表示する
'*****************************************

Sub SHBrowseForFolder_Sample()
    Dim udtBROWSEINFO As BROWSEINFO
    Dim lngPidl As LongPtr              'SHBrowseForFolderの戻り値
    Dim strPath As String * MAX_PATH    'フォルダ名格納
    Dim rc As LongPtr
    
    Dim strClassName As String          'クラス名
    
    'Excelのクラス名を指定
    strClassName = "XLMAIN"

    With udtBROWSEINFO
        'ダイアログボックスの親ウィンドウのハンドル
        .hwndOwner = FindWindow(strClassName, _
                                Application.Caption)
        'Excel2002以降の場合は 変数=Application.Hwnd でもよい
                                
        'ルートフォルダをデスクトップにする
        .pidlRoot = CSIDL_DESKTOP
        
        'タイトル
        .lpszTitle = "フォルダを選択してください"
        
        'ディレクトリのみ選択可能にする
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With

    '[フォルダの参照]ダイアログボックスを開く
    lngPidl = SHBrowseForFolder(udtBROWSEINFO)
    
    If lngPidl = 0& Then
        MsgBox "キャンセルが選択されました"
        Exit Sub
    End If
    
    'SHBrowseForFolderで取得した値からフォルダのフルパスを取得
    rc = SHGetPathFromIDList(lngPidl, strPath)
    
    MsgBox "選択したフォルダ: " & _
        Left(strPath, InStr(strPath, vbNullChar) - 1)
    
    '割り当てられたメモリを開放
    Call CoTaskMemFree(lngPidl)
End Sub
Mình chán không muốn dịch, vì code trên mình test không chạy được trên máy tính cuả mình. Việc khai báo LongPtr và Long vẫn chưa được chỉn chu. Viết lên đây mang tính chất tham khảo thôi, còn việc select folder như ảnh minh họa trên, mọi người google cho nhanh.
 
Top