My Excel Project(2) GaoFeng
FileModel---------------------------------------------------------------------------
Public Function OpenExcelFile(filePath As Variant, visible As Boolean) As Excel.Workbook
Dim excelApp As Excel.Application
Dim excelBook As Excel.Workbook
Set excelApp = New Excel.Application
excelApp.visible = visible
filePath = DeleteLinefeed(filePath)
Set excelBook = excelApp.Workbooks.Open(filePath)
Set OpenExcelFile = excelBook
End Function
Public Function CloseExcelFile(ByRef excelBook As Excel.Workbook)
Dim excelApp As Excel.Application
Set excelApp = excelBook.Application
excelBook.Close savechanges:=True
Set excelBook = Nothing
excelApp.Quit
Set excelApp = Nothing
End Function
Public Function OpenExcelDialog() As Variant
Dim fileOpen As Variant
fileOpen = Application.GetOpenFilename("Microsoft Excel(*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", multiSelect:=True)
If Not IsArray(fileOpen) Then
ReDim fileOpen(1 To 1)
End If
OpenExcelDialog = fileOpen
End Function
Public Function OpenFileDialog(openType As Integer, multiSelect As Boolean) As Variant
Dim dlgOpen As FileDialog
Dim fileNum As Long
Dim filePathArray As Variant
Set dlgOpen = Application.FileDialog(openType)
With dlgOpen
.AllowMultiSelect = multiSelect
.Filters.Clear
.Filters.Add "Excel Files", "*.xlsx;*.xls"
.Filters.Add "All Files", "*.*"
If .Show = -1 Then
ReDim filePathArray(1 To .SelectedItems.Count)
For fileNum = LBound(filePathArray) To UBound(filePathArray)
filePathArray(fileNum) = .SelectedItems(fileNum)
Next fileNum
Else
ReDim filePathArray(1 To 1)
End If
End With
OpenFileDialog = filePathArray
Set dlgOpen = Nothing
End Function
Public Function GetUsedRangeValues(ByRef myWorkbook As Excel.Workbook) As Variant
Dim myWorksheets As Variant
Dim myWorksheet As Excel.Worksheet
Dim i As Long
Dim j As Long
Dim k As Long
Dim resultArray As Variant
Dim startRow As Integer
Dim startColumn As Integer
Dim endRow As Integer
Dim endColumn As Integer
Dim myRange As Excel.Range
Dim value As String
Set myWorksheets = myWorkbook.worksheets
For Each myWorksheet In myWorksheets
With myWorksheet
startRow = .UsedRange.row
startColumn = .UsedRange.column
endRow = .UsedRange.row + .UsedRange.Rows.Count - 1
endColumn = .UsedRange.column + .UsedRange.Columns.Count - 1
For i = startRow To endRow
For j = startColumn To endColumn
Set myRange = .Cells(i, j)
value = myRange.value
If IsNotNull(value) Then
k = k + 1
Call AppendDimArray(resultArray, myWorkbook.Path & "\" & myWorkbook.Name, k, 1)
Call AppendDimArray(resultArray, .Name, k, 2)
Call AppendDimArray(resultArray, i, k, 3)
Call AppendDimArray(resultArray, j, k, 4)
Call AppendDimArray(resultArray, myRange.value, k, 5)
End If
Set myRange = Nothing
Next j
Next i
End With
Next
Set myWorksheets = Nothing
GetUsedRangeValues = resultArray
End Function
Public Function GetFilePathValues(filePath As Variant) As Variant
Dim myWorkbook As Excel.Workbook
Dim resultValueTmp As Variant
Dim resultValue As Variant
Dim i As Integer
For i = LBound(filePath) To UBound(filePath)
Set myWorkbook = OpenExcelFile(filePath(i), False)
resultValueTmp = GetUsedRangeValues(myWorkbook)
Call AppendLinesOFArray(resultValue, resultValueTmp)
Set resultValueTmp = Nothing
Call CloseExcelFile(myWorkbook)
Next i
GetFilePathValues = resultValue
End Function
FileModel---------------------------------------------------------------------------