VBA search nội dung nhiều file excel trong folder

excel-search-folder.bas

Type OPENFILENAME
         IStructSize As Long
         hwndOwner As Long
         hInstance As Long
         lpstrFilter As String
         lpstrCustomFilter As String
         nMaxCustFilter As Long
         nFilterIndex As Long
         lpstrFile As String
         nMaxFile As Long
         lpstrFileTitle As String
         nMaxFileTitle As Long
         lpstrInitialDir As String
         lpstrTitle As String
         flags As Long
         nFileOffset As Integer
         nfileExtension As Integer
         lpstrDefExt As Long
         lCustData As Long
         lpfnHook As Long
         lpTemplateName As String
End Type

Public Const OFN_READONLY = &H1
Public Const OFN_OVERWRITEPROMPT = &H2
Public Const OFN_HIDEREADONLY = &H4
Public Const OFN_SHOEHELP = &H10
Public Const OFN_ALLOWMULTISELECT = &H200
Public Const OFN_EXTENSIONDIFFERENT = &H400
Public Const OFN_PATHMUSTEXIST = &H800
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_CREATEPROMPT = &H2000
Public Const OFN_EXPLORER = &H80000

Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Const SW_SHOWDEFAULT = 10
Public Const SW_MAXIMIZE = 3

Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const G_strTitle As String = "Current folder:"

Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" (lpbi As BROWSEINFO) As Long

Type BROWSEINFO
        hwndOwner      As Long
        pIDLRoot       As Long
        pszDisplayName As Long
        lpszTitle      As Long
        ulFlags        As Long
        lpfnCallback   As Long
        lParam         As Long
        iImage         As Long
End Type

Private Const MAX_PATH       As Long = 260
Private Const CSIDL_DESKTOP  As Long = &H0

Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare PtrSafe Sub CotaskMemFree Lib "ole32.dll" (ByVal pv As Long)


Public Function G_GetFileName(ByVal lngHWnd As Long, _
                              ByVal strFilter As String, _
                              ByVal strDefDir As String) _
                              As String
                              
     Dim strRePathName As String
     Dim typOpenFileName As OPENFILENAME
     Dim Loc As Long
     
     With typOpenFileName
             .IStructSize = Len(typOpenFileName)
             .hwndOwner = lngHWnd
             '.hInstance = App.hInstance
            .lpstrFilter = strFilter
            .nFilterIndex = 1
            .lpstrFile = String(256, Chr(0))
            .nMaxFile = 256
            .lpstrFileTitle = String(256, Chr(0))
            .nMaxFileTitle = 256
            .lpstrInitialDir = strDefDir
            .lpstrTitle = "Change"
            .flags = OFN_HIDEREADONLY Or OFN_FILEMUSTEXIST _
            Or FILEMUSTEXIST Or ofn_hiderreadonly
      End With
      
      If GetOpenFileName(typOpenFileName) = 0 Then
          G_GetFileName = ""
      Else
          strRePathName = typOpenFileName.lpstrFile
          Loc = InStr(typOpenFileName.lpstrFile, vbNullChar)
          G_GetFileName = Left(strRePathName, Loc - 1)
      End If
End Function

Public Function G_GetFolderName(lngHWnd As Long, strPath As String) As String
    'Dim strTitle  As String
    'Dim strSelectFolder  As String
    'Dim udtBrowseInfo   As BROWSEINFO
    'Dim bytDispName(MAX_PATH - 1)  As Byte
    'Dim strDispName  As String
    'Dim lngPidl As Long
    'Dim strFilePath As String
    'Dim ingResult As Long

On Error GoTo G_GetFolderName_Err

    Dim fdFolder As FileDialog
    Set fdFolder = Application.FileDialog(msoFileDialogFolderPicker)

    With fdFolder
        .AllowMultiSelect = False
        .Title = "Search_Setting"
        If (.Show = True) Then
            G_GetFolderName = .SelectedItems(1)
        End If

    End With

    Set fdFolder = Nothing


    'G_GetFolderName = strPath
    
    'strTitle = "Please select a folder"
    
    'With udtBrowseInfo
        '.hwndOwner = lngHWnd
        '.lpszTitle = StrPtr(StrConv(strTitle, vbFromUnicode))
        '.pIDLRoot = CSIDL_DESKTOP
        '.pszDisplayName = VarPtr(bytDispName(0))
        '.ulFlags = BIF_RETURNONLYFSDIRS
    'End With
    
    'lngPidl = SHBrowseForFolder(udtBrowseInfo)
    
    'If lngPidl <> 0 Then
        'strFilePath = Space(MAX_PATH)
        
        'lngResult = SHGetPathFromIDList(lngPidl, strFilePath)
        
        'strFilePath = Left(strFilePath, InStr(strFilePath, vbNullChar) - 1)
        
        'G_GetFolderName = strFilePath & "\"
        
        ''CotaskMemFree lngPidl
     'End If
     Exit Function
     
G_GetFolderName_Err:
     
    G_GetFolderName = ""
End Function

Public Function G_GetPathName(strFullPath As String, strPath As String, strFileName As String) As String
     Dim intStartPosition As Integer
     Dim intStartPosition1 As Integer
     Dim intStartPosition2 As Integer
     Dim intEndPosition As Integer
     Dim intnEndPosition1 As Integer
     Dim intEndPosition2 As Integer
     
     intStartPosition = 1
     intnEndPosition1 = 1
     intnEndPosition2 = 999
     
     Do While (intEndPosition2 <> 0)
     
         intEndPosition2 = InStr(intEndPosition1, strFullPath, "\", vbTextCompare)
         If (intEndPosition2 <> 0) Then
              intEndPosition1 = intEndPosition2 + 1
         End If
     Loop
     intEndPosition = intEndPosition1
     strPath = Mid(strFullPath, intStartPosition, intEndPosition - intStartPosition)
     intStartPosition = intEndPosition
     intEndPosition = Len(strFullPath)
     strFileName = Mid(strFullPath, intStartPosition, intEndPosition - intStartPosition + 1)
     
     G_GetPathName = True
     Exit Function
G_GetPathName_Err:
     G_GetPathName = False
End Function