Hi all,
I got a very weird scenario here, i am using VBA in my MS access forms to do automation to export a table to exceln run a excel macro from MS access. however, the 1st time i open the db n run this form, it works. The 2nd time, it fails, then i need to go to VB editor n acknowledge the error shown on the thread title, after which, the code will run smoothy infinitly... i cannot tell where is my error.. Can anyone pt out my mistake?
the line causing the error is in bold..
i been trying to figure this out since yest, can anyone pls guide me along? thks
FT
I got a very weird scenario here, i am using VBA in my MS access forms to do automation to export a table to exceln run a excel macro from MS access. however, the 1st time i open the db n run this form, it works. The 2nd time, it fails, then i need to go to VB editor n acknowledge the error shown on the thread title, after which, the code will run smoothy infinitly... i cannot tell where is my error.. Can anyone pt out my mistake?
Code:
Private Sub Export_Button_Click() 'export
On Error GoTo Err_Export_Button_Click
Dim objExcel As Excel.Application
Dim objBook As Excel.Workbook
Dim partName As String
Dim langName As String
Dim tempPath As String
Dim strLen As String
Dim userInput As String
Dim userPath As String
Dim blankPic As String
Dim codeLength As String
Dim tempStr As String
Dim tempLength As Integer 'counts length of code
Dim xLoop, yLoop, codeCounter, i As Integer
codeCounter = 1 'counts the total no of codeword for a particular language set
tempLength = 0
langName = ""
If IsNull(Me![ListInput]) Or (Me![ListInput]) = "" Then 'checks if user has selected any language
MsgBox "Please select one of the available languages.", vbExclamation
Exit Sub
End If
If IsNull(Me![tbFile]) Or (Me![tbFile]) = "" Then 'checks for empty export path
MsgBox "Please enter the destination where the output file will be saved!", vbExclamation, "Empty Path"
Me![tbFile].SetFocus
Exit Sub
End If
Select Case ListInput 'assign the filename based on the listbox input
Case "Malay"
langName = "Malay"
Case "Chinese Simplified"
langName = "CH Simplified"
End Select
If Right(tbFile, 3) <> "xls" Then
MsgBox "File to be exported has to be of .xls extension.", vbExclamation
Exit Sub
End If
' On Error GoTo Err_Export_Button_Click
DoCmd.OutputTo acOutputQuery, langName & " Q", acFormatXLS, tbFile, False
MsgBox langName & " successfully exported to " & tbFile & ". Conversion of codes will now begin in the background. Depending on the file size, this process may take a few minutes.", vbInformation, "Exporting of File Completed"
' DoCmd.Hourglass (True)
Set objBook = Nothing
Set objExcel = Nothing
Set objExcel = CreateObject("Excel.Application")
Set objBook = objExcel.Workbooks.Open(tbFile)
objExcel.Cells.Select
objExcel.Selection.RowHeight = 21.01
objExcel.Selection.ColumnWidth = 4.57
objExcel.Columns("B:B").EntireColumn.AutoFit
strLen = Len(objExcel.Cells(2, 3).Value)
tempStr = Left(objExcel.Cells(2, 3).Value, strLen - 6)
xLoop = 1 'start counting the headings
yLoop = 3
While objExcel.Cells(xLoop, yLoop).Value <> ""
tempLength = tempLength + 1
yLoop = yLoop + 1
Wend
blankPic = tempStr & "00.JPG"
codeLength = tempLength
xLoop = 2 'start from Cell(2,3)
yLoop = 3
For xLoop = 2 To 344
For yLoop = 3 To codeLength + 2
If objExcel.Cells(xLoop, yLoop).Value <> blankPic Then
objExcel.Cells(xLoop, yLoop).Select
'changed
[b] objBook.ActiveSheet.Pictures.Insert(ActiveCell.FormulaR1C1). _
Select[/b]
End If
Next
If objExcel.Cells(xLoop + 1, 1).Value = "" Then
GoTo Proceed
End If
Next
Proceed:
objExcel.Range("C2:U343").Select
objExcel.Range("U2").Activate
objExcel.ActiveWindow.SmallScroll Down:=-15
objExcel.Application.CutCopyMode = False
objExcel.Selection.ClearContents
For yLoop = 3 To codeLength + 2 'create row headings for 1st row
objExcel.Cells(1, yLoop).Value = codeCounter
codeCounter = codeCounter + 1
objExcel.Cells(1, yLoop).Select
With objExcel.Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
objExcel.Selection.Font.Bold = True
With Selection.Font
.Name = "MS Sans Serif"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With objExcel.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Next
objExcel.Range("A1:B1").Select 'create the heading for 1st row
With objExcel.Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
objExcel.Selection.Font.Bold = True
With Selection.Font
.Name = "MS Sans Serif"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With objExcel.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
objExcel.ActiveWorkbook.Save 'saves the file after conversion
objExcel.Workbooks.Close
Set objBook = Nothing
objExcel.Quit
Set objExcel = Nothing
' DoCmd.Hourglass (False)
MsgBox langName & " has been successfully converted to codes in " & tbFile, vbInformation, "Conversion Successfully"
Exit_Export_Button_Click:
Exit Sub
Err_Export_Button_Click:
objExcel.Workbooks.Close
Set objBook = Nothing
objExcel.Quit
Set objExcel = Nothing
'DoCmd.Hourglass (False)
MsgBox "Error - " & Err.Description, vbExclamation
Resume Exit_Export_Button_Click
End Subthe line causing the error is in bold..
i been trying to figure this out since yest, can anyone pls guide me along? thks
FT
Last edited:
