brayant
01-18-2007, 08:38 PM
Hi All, I have create a Excel VB Application that means when i load the excel file data to database the first time can load in the database but after go back to load again the data it have error as
Method 'Range' of Object '_Global' failed
Bellow is the code that i have write
---------------------------------------------------------------
Private Sub cmdLoad_Click()
On Error GoTo errHandler:
Dim xlsApp As Object
Dim xlsWB1 As Object
Dim xlsWS1 As Object
Dim strPath As String
ProgressBar1.Value = 1
dataFormat = "New"
Set xlsApp = CreateObject("Excel.Application")
xlsApp.Visible = False
strPath = File1.Path & "\" & File1.FileName
Set xlsWB1 = xlsApp.Workbooks.Open(strPath)
Set xlsWS1 = xlsWB1.Worksheets("Scrap IC")
Call WriteToLogFile1(strPath)
Dim row As Integer
Dim maxrow1 As Integer
Dim strSQL As String
Dim lngRecsAff As Long
Dim PBarCounter As Integer
maxrow1 = Range("A65536").End(xlUp).row
strSQL1 = "Insert Into tblscrap_Archive Select * From tblscrap "
adocn.Execute strSQL1, lngRecsAff, adExecuteNoRecords
strSQL2 = "Delete tblscrap "
adocn.Execute strSQL2, lngRecsAff, adExecuteNoRecords
PBarCounter = 0
For row = 2 To maxrow1
ProgressBar1.Refresh
ProgressBar1.Max = maxrow1 + 3 + PBarCounter
ProgressBar1.Value = PBarCounter
strSQL3 = "Insert Into tblscrap(KTC_PART_No, IC_PN, KTC_WO, COO, Sheet_No, NANYA_WO, Qty, Scrap_IC_ID)Values('" & xlsWS1.Cells(row, 1).Value & "','" & xlsWS1.Cells(row, 2).Value & "','" & xlsWS1.Cells(row, 3).Value & "','" & xlsWS1.Cells(row, 4).Value & "','" & xlsWS1.Cells(row, 5).Value & "','" & xlsWS1.Cells(row, 6).Value & "','" & xlsWS1.Cells(row, 7).Value & "','" & xlsWS1.Cells(row, 8).Value & "')"
adocn.Execute strSQL3, lngRecsAff, adExecuteNoRecords
PBarCounter = PBarCounter + 5
Next
strSQL4 = "Update tblscrap set Date_Load = '" & Date + Time & "', File_Name ='" & strPath & "' "
adocn.Execute strSQL4, lngRecsAff, adExecuteNoRecords
'odocn.Close
'Set cn1 = Nothing
xlsWB1.Close
xlsApp.Quit
Set xlsApp = Nothing
Set xlsWB1 = Nothing
Set xlsWS1 = Nothing
Me.Hide
ScrapIC.Show
Exit Sub
errHandler:
'MsgBox "An unknown error occurred while Passing the Excel. Sorry about that!!", vbCritical, "Error"
MsgBox Err.Description, vbCritical, "Error"
'xlsWB1.Close
xlsApp.Quit
Set xlsApp = Nothing
'Set xlsWB1 = Nothing
Set xlsWS1 = Nothing
End Sub
-----------------------------------------------------
Hope can help me
thanks
Method 'Range' of Object '_Global' failed
Bellow is the code that i have write
---------------------------------------------------------------
Private Sub cmdLoad_Click()
On Error GoTo errHandler:
Dim xlsApp As Object
Dim xlsWB1 As Object
Dim xlsWS1 As Object
Dim strPath As String
ProgressBar1.Value = 1
dataFormat = "New"
Set xlsApp = CreateObject("Excel.Application")
xlsApp.Visible = False
strPath = File1.Path & "\" & File1.FileName
Set xlsWB1 = xlsApp.Workbooks.Open(strPath)
Set xlsWS1 = xlsWB1.Worksheets("Scrap IC")
Call WriteToLogFile1(strPath)
Dim row As Integer
Dim maxrow1 As Integer
Dim strSQL As String
Dim lngRecsAff As Long
Dim PBarCounter As Integer
maxrow1 = Range("A65536").End(xlUp).row
strSQL1 = "Insert Into tblscrap_Archive Select * From tblscrap "
adocn.Execute strSQL1, lngRecsAff, adExecuteNoRecords
strSQL2 = "Delete tblscrap "
adocn.Execute strSQL2, lngRecsAff, adExecuteNoRecords
PBarCounter = 0
For row = 2 To maxrow1
ProgressBar1.Refresh
ProgressBar1.Max = maxrow1 + 3 + PBarCounter
ProgressBar1.Value = PBarCounter
strSQL3 = "Insert Into tblscrap(KTC_PART_No, IC_PN, KTC_WO, COO, Sheet_No, NANYA_WO, Qty, Scrap_IC_ID)Values('" & xlsWS1.Cells(row, 1).Value & "','" & xlsWS1.Cells(row, 2).Value & "','" & xlsWS1.Cells(row, 3).Value & "','" & xlsWS1.Cells(row, 4).Value & "','" & xlsWS1.Cells(row, 5).Value & "','" & xlsWS1.Cells(row, 6).Value & "','" & xlsWS1.Cells(row, 7).Value & "','" & xlsWS1.Cells(row, 8).Value & "')"
adocn.Execute strSQL3, lngRecsAff, adExecuteNoRecords
PBarCounter = PBarCounter + 5
Next
strSQL4 = "Update tblscrap set Date_Load = '" & Date + Time & "', File_Name ='" & strPath & "' "
adocn.Execute strSQL4, lngRecsAff, adExecuteNoRecords
'odocn.Close
'Set cn1 = Nothing
xlsWB1.Close
xlsApp.Quit
Set xlsApp = Nothing
Set xlsWB1 = Nothing
Set xlsWS1 = Nothing
Me.Hide
ScrapIC.Show
Exit Sub
errHandler:
'MsgBox "An unknown error occurred while Passing the Excel. Sorry about that!!", vbCritical, "Error"
MsgBox Err.Description, vbCritical, "Error"
'xlsWB1.Close
xlsApp.Quit
Set xlsApp = Nothing
'Set xlsWB1 = Nothing
Set xlsWS1 = Nothing
End Sub
-----------------------------------------------------
Hope can help me
thanks