My Excel Project(2) GaoFeng

[gaofengld]

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---------------------------------------------------------------------------