Hi, Killian
Thank you for your help. I tried to edit code again. see below is my code:
Option Explicit
Dim strSourceP As String
Dim strDestP As String
Dim strBackP As String
Dim strOldP As String
Dim strSourceF As String
Dim strDestF As String
Dim strBackF As String
Dim strOldF As String
Dim strOldFO As String
Dim curDT As String
Dim strWorkbook As String
Dim appXL As Excel.Application
Dim destWB As Excel.Workbook
Dim backWB As Excel.Workbook
Dim destWS As Excel.Worksheet
Dim backWS As Excel.Worksheet
Dim oWS As Excel.Worksheet
Dim msg As String
Dim sourceCount As Integer
Private Sub btnCancel_Click()
Dim objform As Form
For Each objform In Forms
Unload objform
Next
End Sub
Private Sub btnConfirm_Click()
Dim answer As String
On Error GoTo errCloseFile
curDT = Format(Now, "ddmmyyhhmm")
strSourceF = lbxFile.Path + "\" + lbxFile.FileName
'frmConfirm.Show
answer = MsgBox("The file '" & lbxFile.FileName & "' choice is ok?", _
vbOKCancel, "Choice OK")
If answer <> 1 Then
strSourceF = ""
Else
' set if file open
strDestF = strDestP + Left(lbxFile.FileName, _
Len(lbxFile.FileName) - 4) & curDT & ".XLS"
strOldF = strOldP + lbxFile.FileName
FileCopy strSourceF, strOldP + lbxFile.FileName
FileCopy strSourceF, strDestF
btnExport.Enabled = True
'FileCopy strOldFO, strBackF
End If
Exit Sub
errCloseFile:
MsgBox "Please close your file", vbOKOnly, "Close File"
End Sub
Private Sub btnExport_Click()
Dim i As Integer
Dim temp1 As String
Dim backCount As Integer
Dim iRowDest As Integer
'On Error GoTo errCodeNot
i = 2
backCount = 2
iRowDest = 2
Set appXL = New Excel.Application
Set destWB = appXL.Workbooks.Open(strDestF)
Set backWB = appXL.Workbooks.Open(strBackF)
Set destWS = destWB.Worksheets("DETAIL")
Set backWS = backWB.Worksheets("WYETH")
destWS.Cells(1, 31) = "Wyeth"
Do While destWS.Cells(iRowDest, 30) <> ""
Dim findString As String
Dim rang1 As Range
Set rang1 = backWS.Range("A2:B10000")
findString = destWS.Cells(iRowDest, 30)
destWS.Cells(iRowDest, 31) = Application.VLookup(findString, rang1, 2, False)
iRowDest = iRowDest + 1
sourceCount = iRowDest
Loop
destWS.Cells(sourceCount, 25) = "=SUM(Y2:Y" & sourceCount - 1 & ")"
lbxFile.Refresh
Kill (strSourceF)
MsgBox "Finish to add Wyeth Code!", vbOKOnly, "Finish"
backWB.Close False
destWB.Close False
appXL.Quit
Set backWB = Nothing
Set destWB = Nothing
Set appXL = Nothing
'clean up and exit
'Set oWS = Nothing
'If Not oWB Is Nothing Then oWB.Close
' Set oWB = Nothing
' 'destXL.Quit
' 'backXL.Quit
' 'Kill (strBackF)
' btnExport.Enabled = False
' Set destXL = Nothing
' Set backXL = Nothing
' Application.Quit
' btnExport.Enabled = False
' btnConfirm.Enabled = False
' Excel.Application.Quit
'backXL.SaveWorkspace (strBackF)
'destXL.SaveWorkspace (strDestF)
'Exit Sub
'errCodeNot:
' MsgBox Err.Description
' 'MsgBox "The WYETH Location code '" & _
destXL.Cells(iRowDest, 30) & "' can not be found, Pls check it"
' btnExport.Enabled = False
' lbxFile.Refresh
' destXL.Workbooks.Close
' Kill (strDestF)
' Kill (strOldF)
' Set oWS = Nothing
' If Not oWB Is Nothing Then oWB.Close
' Set oWB = Nothing
' 'backXL.Quit
' 'excel.Application.ActiveWorkbook.Close(savechanges:=False, _
FileName:=strBackF) = False
' 'destXL.Quit
' btnExport.Enabled = False
' btnConfirm.Enabled = False
' Set destXL = Nothing
' Set backXL = Nothing
' Application.Quit
' Excel.Workbooks.Close
' Excel.Workbooks.Application.Quit
End Sub
Private Sub cmdFresh_Click()
lbxFile.Refresh
btnConfirm.Enabled = True
End Sub
Private Sub Form_Load()
On Local Error GoTo ErrorHandle
'lbxFile.Path = "c:\wyeth1\import"
lbxFile.Path = "c:\wyeth\import"
strSourceP = "c:\wyeth\import\"
strDestP = "c:\wyeth\export\"
strOldP = "c:\wyeth\old\"
lblImEx = "Im"
strBackP = "C:\wyeth\backup\"
lblFilename.Caption = ""
strBackF = "c:\wyeth\backup\wyeth.xls"
'strOldFO = "c:\wyeth\old\wyeth.xls"
'FileCopy strOldFO, strBackF
btnConfirm.Enabled = True
btnExport.Enabled = False
Exit Sub
ErrorHandle:
MsgBox Err.Description & Err.Number
MsgBox "Please create the fold C:\WYETH\IMPORT, _
C:\WYETH\EXPORT, C:\WYETH\BACKUP under C: Driver and press the <<Fresh>> Button"
btnConfirm.Enabled = False
btnExport.Enabled = False
cmdFresh.Enabled = False
End Sub
Private Sub lbxFile_Click()
With Clipboard
.Clear
.SetText lbxFile.FileName, vbCFText
End With
lblFilename.Caption = lbxFile.FileName
End Sub
First time run this applicaiton is well. But the second time run this application,
When run to destWS.Cells(iRowDest, 31) = Application.VLookup(findString, rang1, 2, False)
come the error message: Run-time error '1004'
Application-defined or object-defined error. The same problem is as before.
Hope to get your continue help!
Best Regards
Sleeper: Can't run second times in VB code!
Dear friends,
Reply With Quote
Originally Posted by yihong
