Public Function ExcelProcess(ByVal workbook As String, ByVal ExcelSheetName As String, ByVal row As Integer, ByVal col As Integer)
'Works out the number of lines in input file (or excel worksheet)
'Sets up status bar
Dim sVer As String = String.Empty
Dim sVer2 As String = String.Empty
Dim iHandle As IntPtr
Dim h As Integer = row
Dim i As Integer
Dim xlApp As Object = Nothing
Dim xlSecondapp As Object = Nothing
Dim fieldname As String = String.Empty
Dim arrstart As New ArrayList
Dim stroccno As String = String.Empty
Dim Result As Boolean
Dim ColCount As Integer
Dim k As Integer
Dim xlWB As Object = Nothing
Dim xlWS As Object = Nothing
Dim xlsecondwb As Object = Nothing
Dim xlsecondws As Object = Nothing
FlagGetObj = False
With frmmain
If Not FlagStop Then
numline = 0
'Excel file
If Not GetDataTypes() Then 'Call function which fills TableName and database specific info into mapping array
'If error within GetDataTypes function
AddMessage("Unexpected Error Has Occured")
Return Nothing
Exit Function
End If
Record_Progress.Value = 0
Record_Progress.Minimum = 0
'While more fields in mapping
Try
If Not FlagStop Then
If (ProduceControlTotals) Then
Result = ProduceTotals("BEFORE")
If (Not Result) Then 'Totals errored....do not load this map
'Finished - clear the status bar
Return Result
Exit Function
End If
End If
xlApp = CreateObject("Excel.Application")
FlagGetObj = True
xlApp.visible = False
xlApp.displayalerts = False
xlWB = xlApp.Workbooks.Open(workbook) ' change the name of the sheet you require
Application.DoEvents()
xlWS = xlWB.Worksheets(ExcelSheetName)
xlWS.Activate()
ColCount = xlWS.Cells.SpecialCells(xlCellTypeLastCell).column
k = GetColumnRowCount(col, xlWS, xlApp) 'get number of records in excel sheet
.prglabel.Text = CStr(Record_Progress.Value)
Record_Progress.Maximum = k
Dim dgcnt As Integer = .DgInitialData.Rows.Count
'Create a new workbook in Excel.
' xlSecondapp = CreateObject("Excel.Application")
Try
'this is excel sheets for reject file
xlSecondapp = New Excel.Application
xlsecondwb = xlSecondapp.Workbooks.Open(RejectFile)
xlsecondws = xlsecondwb.Worksheets(1)
xlSecondapp.visible = False
Catch ex As System.Runtime.InteropServices.COMException
xlSecondapp = CreateObject("Excel.Application")
xlsecondwb = xlSecondapp.Workbooks.add
xlsecondws = xlsecondwb.Worksheets(1)
If RejectFile <> String.Empty Then
xlsecondwb.SaveAs(RejectFile)
Else
End If
xlSecondapp.visible = False
End Try
SourceSheet = CType(xlWS, Excel.Worksheet) 'source sheet
TargetSheet = CType(xlsecondws, Excel.Worksheet) 'reject file
'CreateExcel()
i = row - 1
For i = i To k - 1
IntRowtargetExcel = i 'starting row
ArrayofColValues.Clear()
For f As Integer = 0 To dgcnt - 1
With Mapping(f)
If (xlApp.Cells(h, .Pos).VALUE) IsNot DBNull.Value Then
ArrayofColValues.Add((xlApp.cells(h, .Pos).VALUE))
Else
ArrayofColValues.Add(String.Empty)
End If
End With
Next
LoadData = True
ExistInTable = False
MemberExists = False
RejectNo = -1
'Clear all values from last record and reset value count
numline += 1 ' RecordsProcessed + 1
DelCreateQuery.Invoke()
'Delegate call to update main form
'Record_Progress.Value += 1
'RecordsProcessed = Record_Progress.Value
'.prglabel.Text = CStr(k - Record_Progress.Value)
DelUpdForm.Invoke()
h += 1 'row position
If FlagStop Then
AddMessage("Load stopped by user", "0")
Return Nothing
Exit Function
End If
Next
' closeExcel()
End If
Catch ex As System.Runtime.InteropServices.COMException
AddMessage("Error opening workbook: " & workbook & " And Sheet: " & ExcelSheetName & " Not found, please check that sheet exists and spelling is correct", "0")
Catch ex As System.IO.FileNotFoundException
AddMessage(CStr(FormatMessage(20, " " & InputFileName)), "0")
Catch ex As System.IO.IOException
AddMessage(CStr(FormatMessage(20, " " & InputFileName)), "0")
Catch ex As Exception
MsgBox(ex.ToString)
AddMessage("Error opening workbook: " & workbook & " And Sheet: " & ExcelSheetName & " Not found, please check that sheet exists and spelling is correct", "0")
Finally
If (ProduceControlTotals) Then
Result = ProduceTotals("AFTER") 'later
doContTotalNotLoaded() 'later 'Populate the not loaded data field, with any rejected/unloaded data
End If
CustomPostSettings() 'After a load is completed display any custom messages/reports
'Finished - clear the status bar
doInsertOnly = False 'validation check
OverwriteData = False 'validation check
SkipBlankData = False
doUpdatesOnly = False
doWarningUpdates = False
doWarningInsert = False
IsHistoryTable = False
FlagNewLoad = False
stroccno = String.Empty
ArrayofColValues.Clear()
Erase Mapping
If Not FlagStop Then
.prglabel.Text = CStr(0)
End If
' xlsecondwb.save()
sVer = xlApp.version
iHandle = IntPtr.Zero
If Val(sVer) >= 10 AndAlso FlagGetObj Then
iHandle = New IntPtr(DirectCast(xlApp.Parent.Hwnd, Integer))
sVer = xlApp.version
iHandle = IntPtr.Zero
EnsureProcessKilled(iHandle, System.Guid.NewGuid.ToString.ToUpper)
Else
xlWS = Nothing
xlWB.Close(False)
xlWB = Nothing
xlApp.quit()
xlApp = Nothing
End If
sVer2 = xlSecondapp.version
iHandle = IntPtr.Zero
If Val(sVer) >= 10 Then
iHandle = New IntPtr(DirectCast(xlApp.Parent.Hwnd, Integer))
sVer = xlApp.version
iHandle = IntPtr.Zero
EnsureProcessKilled(iHandle, System.Guid.NewGuid.ToString.ToUpper)
Else
xlsecondws = Nothing
xlsecondwb.Close(False)
xlsecondwb = Nothing
xlSecondapp.quit()
xlSecondapp = Nothing
System.Threading.Thread.Sleep(500)
End If
TargetSheet = Nothing
SourceSheet = Nothing
System.Threading.Thread.Sleep(500)
FlaggTbleNtPD = False
CloseFiles() 'Close all the files
End Try
End If 'flag stop
Return Nothing
End With
End Function
Public Sub EnsureProcessKilled(ByVal MainWindowHandle As IntPtr, ByVal Caption As String)
'to kill excel instance running in task manger
Try
SetLastError(0)
' for Excel versions <10, this won't be set yet
If IntPtr.Equals(MainWindowHandle, IntPtr.Zero) Then _
MainWindowHandle = FindWindow(Nothing, Caption)
If IntPtr.Equals(MainWindowHandle, IntPtr.Zero) Then _
Exit Sub ' at this point, presume the window has been closed.
Dim iRes, iProcID As Integer
iRes = GetWindowThreadProcessId(MainWindowHandle, iProcID)
If iProcID = 0 Then ' can’t get Process ID
If EndTask(MainWindowHandle) <> 0 Then Exit Sub ' success
Throw New ApplicationException("Failed to close.")
End If
Dim proc As System.Diagnostics.Process
proc = System.Diagnostics.Process.GetProcessById(iProcID)
proc.CloseMainWindow()
proc.Refresh()
If proc.HasExited Then Exit Sub
proc.Kill()
Catch ex As Exception
MsgBox(ex.ToString)
End Try
End Sub
Public Sub CloseFiles()
On Error Resume Next
FileClose() 'Close all the text files.
If ExcelSheet Then
'UPGRADE_WARNING: Couldn't resolve default property of object MsExcel.Workbooks. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
MsExcel.Workbooks(GetName(False, InputFileName, True)).Close(False)
'UPGRADE_WARNING: Couldn't resolve default property of object MsExcel.Workbooks. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
MsExcel.Workbooks(GetName(False, RejectFile, True)).Close(True)
End If
If Kill_Rej Then Kill(RejectFile)
End Sub
|
