VBA Excel insert row gives error 1004

[joel009]

I have coded an insert row into Excel that works 99% of the time. The submitter for the spreadsheet know enough about Excel to be dangerous. Every so often I get a spreadsheet that generates a 1004 error on the insert row statement and the description from Access 2003 is that it can't insert the row as it will bump off data. I even delete a row to prevent the error. I manually delete all rows under the data and get the same error. The only way I can get it to work is to copy/paste used rows on a new sheet in the same workbook. I would like to find a work around other than manually or programatically copy pasting to a new sheet. I also get a 1004 error occasinally and the description is that it can't unlock the cells. I'm assuming then that error 1004 is a generic for an Excell error?

Here is the start of my sub:

Public Sub ImportProcessExportAssetCenterOutput_Spreadsheets()

'import excel from HACMFTP_TO_DO

Dim xlapp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
' Dim strCurrentWorkbook As String
Dim strNewWorkbookName As String
Dim lngLastRow As Long
Dim strRange As String
Dim fs1 As Object
Dim strWorkingDir As String
Dim strFileName As String
Dim varCellCount As Variant
Dim blnNoFilesFound As Boolean
Dim blnAnyFileFound As Boolean
Dim strColumnName As String
Dim strNewName As String
Dim lngCountOfHACM_Action As Long
Dim lngCountofDupSN As Long
Dim intCellcount As Integer

On Error GoTo ErrorHandler

'start with clean tables
CleanUpTables

'remove rows from HACM_Exports_Combined older than 12 hrs
DoCmd.SetWarnings False
DoCmd.RunSQL "Delete * from HACM_Exports_Combined where DateDiff('h',[ProcessingTimeStamp],Now()) >= 12"
DoCmd.SetWarnings True

DoCmd.Hourglass True

strWorkingDir = "D:\FTPData\HACMFTP_TO_DO"
strFileName = "*.xls"
blnNoFilesFound = False
blnAnyFileFound = False

Do Until blnNoFilesFound = True

Set fs1 = Application.FileSearch
With fs1
.NewSearch
.LookIn = strWorkingDir
.FileName = strFileName
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then

blnAnyFileFound = True
'open workbooks and transfer info to table of same name
Set xlapp = CreateObject("Excel.Application")
xlapp.DisplayAlerts = False

Set xlBook = xlapp.Workbooks.Open(.FoundFiles(1))
Set xlSheet = xlBook.Sheets(1)
'set variables for file copy and delete
strCurrentWorkbook = xlBook.Name

xlSheet.Activate
'edited 9-25-2008 to set lngLastRow value to 506, processing after import will remove invalid and empty rows. JFH
''' lngLastRow = xlSheet.UsedRange.Rows.Count + 1
'updated process to find last record 8/25/2008 JFH
''' varCellCount = 1
''' intCellcount = 1
''' For Each varCellCount In xlSheet.Range("A2:A501").Cells
''' If IsNull(varCellCount.Value) = True Or Trim(varCellCount.Value) = "" And intCellcount > 5 Then
''' lngLastRow = intCellcount + 1
''' Exit For
''' End If
''' intCellcount = intCellcount + 1
''' Next
'''
''' If lngLastRow > 501 Or lngLastRow = 0 Then 'lngLastRow = 0 means there are more than 501 records
xlSheet.Rows(506).Delete
lngLastRow = 506 'add one row to account for row added in next step, it will be deleted
''' End If

xlSheet.Range("B1:GO506").Select
xlSheet.Range("B1:GO506").Locked = False

xlSheet.Rows("2:2").Select

'insert row for Alpha data so Excel imports columns as text.
'the row will be deleted later in processing
xlapp.Selection.Insert Shift:=xlShiftDown

'format all columns to text
xlSheet.Columns("B:GO").NumberFormat = "@"
xlSheet.Range("B1:GO" & lngLastRow).Replace What:=Chr(8), Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
xlSheet.Range("B1:GO" & lngLastRow).Replace What:=Chr(9), Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
xlSheet.Range("B1:GO" & lngLastRow).Replace What:=Chr(10), Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
xlSheet.Range("B1:GO" & lngLastRow).Replace What:=Chr(13), Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
xlSheet.Range("B1:GO" & lngLastRow).Replace What:=Chr(34), Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Added 10/17/2008 JFH
'replace HACM_Action if it exists with Action
xlSheet.Range("A1").Replace What:="HACM_Action", Replacement:="Action", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Added 10/17/2008 JFH
'replace Prvider/Lessor if it exists with ProviderLesser
xlSheet.Range("BS1").Replace What:="Provider/Lessor", Replacement:="ProviderLessor", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Remove "'" Removed 10-22-2007 JFH due to conflicts on some entries
''' xlSheet.Range("B1:GO" & lngLastRow).Replace What:=Chr(39), Replacement:="", LookAt:=xlPart, _
''' SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
''' ReplaceFormat:=False

'trim asset tag and SN
''' varCellCount = 1
''' For Each varCellCount In xlSheet.Range("B1:GO" & lngLastRow).Cells
''' varCellCount.Value = Trim(varCellCount.Value)
''' Next

varCellCount = 1
For Each varCellCount In xlSheet.Range("B2:B" & lngLastRow).Cells
varCellCount.Value = Trim(varCellCount.Value)
Next

varCellCount = 1
For Each varCellCount In xlSheet.Range("BW2:BW" & lngLastRow).Cells
varCellCount.Value = Trim(varCellCount.Value)
Next

'insert an alpha character into cells of first row so they import as text
'the row will be deleted later in processing
varCellCount = 1
intCellcount = 1
For Each varCellCount In xlSheet.Range("B2:GO2").Cells
Select Case intCellcount
Case 1, 30, 58, 60, 65, 66, 67, 74, 153
varCellCount.Value = Chr(65) & varCellCount.Value
End Select
intCellcount = intCellcount + 1
Next

'add # to columns that do not import in correct format
'The # will be removed later in processing
varCellCount = 1
For Each varCellCount In xlSheet.Range("B2:B" & lngLastRow).Cells
varCellCount.Value = Chr(35) & (varCellCount.Value)
Next

varCellCount = 1
For Each varCellCount In xlSheet.Range("BG2:BG" & lngLastRow).Cells
varCellCount.Value = Chr(35) & (varCellCount.Value)
Next

varCellCount = 1
For Each varCellCount In xlSheet.Range("BI2:BI" & lngLastRow).Cells
varCellCount.Value = Chr(35) & (varCellCount.Value)
Next

varCellCount = 1
For Each varCellCount In xlSheet.Range("BW2:BW" & lngLastRow).Cells
varCellCount.Value = Chr(35) & (varCellCount.Value)
Next

varCellCount = 1
For Each varCellCount In xlSheet.Range("BN2:BN" & lngLastRow).Cells
varCellCount.Value = Chr(35) & (varCellCount.Value)
Next

varCellCount = 1
For Each varCellCount In xlSheet.Range("BO2:BO" & lngLastRow).Cells
varCellCount.Value = Chr(35) & (varCellCount.Value)
Next

varCellCount = 1
For Each varCellCount In xlSheet.Range("BP2:BP" & lngLastRow).Cells
varCellCount.Value = Chr(35) & (varCellCount.Value)
Next

varCellCount = 1
For Each varCellCount In xlSheet.Range("EX2:EX" & lngLastRow).Cells
varCellCount.Value = Chr(35) & (varCellCount.Value)
Next

'netid and SN to ucase
varCellCount = 1
For Each varCellCount In xlSheet.Range("AC2:AC" & lngLastRow).Cells
varCellCount.Value = UCase(varCellCount.Value)
Next

varCellCount = 1
For Each varCellCount In xlSheet.Range("BW2:BW" & lngLastRow).Cells
varCellCount.Value = UCase(varCellCount.Value)
Next

varCellCount = 1
For Each varCellCount In xlSheet.Range("CQ2:CQ" & lngLastRow).Cells
varCellCount.Value = UCase(varCellCount.Value)
Next

varCellCount = 1
For Each varCellCount In xlSheet.Range("DD2D" & lngLastRow).Cells
varCellCount.Value = UCase(varCellCount.Value)
Next

varCellCount = 1
For Each varCellCount In xlSheet.Range("DZ2Z" & lngLastRow).Cells
varCellCount.Value = UCase(varCellCount.Value)
Next

'set variable for rowcount
strRange = "A1:GO" & lngLastRow

'set varible for Add/Mod
strAddModIndicater = xlSheet.Cells(3, 1).Value

'close instance of Excel
xlBook.Close savechanges:=True

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Working_HACM", strWorkingDir & "\" & strCurrentWorkbook, True, strRange


Any ideas?

Thanks Joel

 

[PHV]

Which line of code raises the error ?
What is the smallest code exhibiting this behaviour ?
Note: to better debug your code comment out any error handling.

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[joel009]

PH - I originally trapped for error 1004 and did a Resume Next. Now that is not good enough as it then corrupts the first row of data as I append "A" or "#" to columns that need to be imported as text which should be the blank row I insert. The submitter has done something to the spreadsheet I can't figure out.

The error I'm batteling occurs at:

'insert row for Alpha data so Excel imports columns as text.
'the row will be deleted later in processing
xlapp.Selection.Insert Shift:=xlShiftDown

 

[RoyVidar]

There's information somewhere in the bottom row of the worksheet, I think, and Excel objects to adding another row, because that would cause this information to shift off the worksheet.

Roy-Vidar

 

[joel009]

Roy- I searched the whole Acces db and there is only one insert statement. Her is the whole sub:

Public Sub ImportProcessExportAssetCenterOutput_Spreadsheets()

'import excel from HACMFTP_TO_DO

Dim xlapp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
' Dim strCurrentWorkbook As String
Dim strNewWorkbookName As String
Dim lngLastRow As Long
Dim strRange As String
Dim fs1 As Object
Dim strWorkingDir As String
Dim strFileName As String
Dim varCellCount As Variant
Dim blnNoFilesFound As Boolean
Dim blnAnyFileFound As Boolean
Dim strColumnName As String
Dim strNewName As String
Dim lngCountOfHACM_Action As Long
Dim lngCountofDupSN As Long
Dim intCellcount As Integer

On Error GoTo ErrorHandler

'start with clean tables
CleanUpTables

'remove rows from HACM_Exports_Combined older than 12 hrs
DoCmd.SetWarnings False
DoCmd.RunSQL "Delete * from HACM_Exports_Combined where DateDiff('h',[ProcessingTimeStamp],Now()) >= 12"
DoCmd.SetWarnings True

DoCmd.Hourglass True

strWorkingDir = "D:\FTPData\HACMFTP_TO_DO"
strFileName = "*.xls"
blnNoFilesFound = False
blnAnyFileFound = False

Do Until blnNoFilesFound = True

Set fs1 = Application.FileSearch
With fs1
.NewSearch
.LookIn = strWorkingDir
.FileName = strFileName
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then

blnAnyFileFound = True
'open workbooks and transfer info to table of same name
Set xlapp = CreateObject("Excel.Application")
xlapp.DisplayAlerts = False

Set xlBook = xlapp.Workbooks.Open(.FoundFiles(1))
Set xlSheet = xlBook.Sheets(1)
'set variables for file copy and delete
strCurrentWorkbook = xlBook.Name

xlSheet.Activate
'edited 9-25-2008 to set lngLastRow value to 506, processing after import will remove invalid and empty rows. JFH
''' lngLastRow = xlSheet.UsedRange.Rows.Count + 1
'updated process to find last record 8/25/2008 JFH
''' varCellCount = 1
''' intCellcount = 1
''' For Each varCellCount In xlSheet.Range("A2:A501").Cells
''' If IsNull(varCellCount.Value) = True Or Trim(varCellCount.Value) = "" And intCellcount > 5 Then
''' lngLastRow = intCellcount + 1
''' Exit For
''' End If
''' intCellcount = intCellcount + 1
''' Next
'''
''' If lngLastRow > 501 Or lngLastRow = 0 Then 'lngLastRow = 0 means there are more than 501 records
xlSheet.Rows(506).Delete
lngLastRow = 506 'add one row to account for row added in next step, it will be deleted
''' End If

xlSheet.Range("B1:GO506").Select
xlSheet.Range("B1:GO506").Locked = False

xlSheet.Rows("2:2").Select

'insert row for Alpha data so Excel imports columns as text.
'the row will be deleted later in processing
xlapp.Selection.Insert Shift:=xlShiftDown

'format all columns to text
xlSheet.Columns("B:GO").NumberFormat = "@"
xlSheet.Range("B1:GO" & lngLastRow).Replace What:=Chr(8), Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
xlSheet.Range("B1:GO" & lngLastRow).Replace What:=Chr(9), Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
xlSheet.Range("B1:GO" & lngLastRow).Replace What:=Chr(10), Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
xlSheet.Range("B1:GO" & lngLastRow).Replace What:=Chr(13), Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
xlSheet.Range("B1:GO" & lngLastRow).Replace What:=Chr(34), Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Added 10/17/2008 JFH
'replace HACM_Action if it exists with Action
xlSheet.Range("A1").Replace What:="HACM_Action", Replacement:="Action", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Added 10/17/2008 JFH
'replace Prvider/Lessor if it exists with ProviderLesser
xlSheet.Range("BS1").Replace What:="Provider/Lessor", Replacement:="ProviderLessor", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Remove "'" Removed 10-22-2007 JFH due to conflicts on some entries
''' xlSheet.Range("B1:GO" & lngLastRow).Replace What:=Chr(39), Replacement:="", LookAt:=xlPart, _
''' SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
''' ReplaceFormat:=False

'trim asset tag and SN
''' varCellCount = 1
''' For Each varCellCount In xlSheet.Range("B1:GO" & lngLastRow).Cells
''' varCellCount.Value = Trim(varCellCount.Value)
''' Next

varCellCount = 1
For Each varCellCount In xlSheet.Range("B2:B" & lngLastRow).Cells
varCellCount.Value = Trim(varCellCount.Value)
Next

varCellCount = 1
For Each varCellCount In xlSheet.Range("BW2:BW" & lngLastRow).Cells
varCellCount.Value = Trim(varCellCount.Value)
Next

'insert an alpha character into cells of first row so they import as text
'the row will be deleted later in processing
varCellCount = 1
intCellcount = 1
For Each varCellCount In xlSheet.Range("B2:GO2").Cells
Select Case intCellcount
Case 1, 30, 58, 60, 65, 66, 67, 74, 153
varCellCount.Value = Chr(65) & varCellCount.Value
End Select
intCellcount = intCellcount + 1
Next

'add # to columns that do not import in correct format
'The # will be removed later in processing
varCellCount = 1
For Each varCellCount In xlSheet.Range("B2:B" & lngLastRow).Cells
varCellCount.Value = Chr(35) & (varCellCount.Value)
Next

varCellCount = 1
For Each varCellCount In xlSheet.Range("BG2:BG" & lngLastRow).Cells
varCellCount.Value = Chr(35) & (varCellCount.Value)
Next

varCellCount = 1
For Each varCellCount In xlSheet.Range("BI2:BI" & lngLastRow).Cells
varCellCount.Value = Chr(35) & (varCellCount.Value)
Next

varCellCount = 1
For Each varCellCount In xlSheet.Range("BW2:BW" & lngLastRow).Cells
varCellCount.Value = Chr(35) & (varCellCount.Value)
Next

varCellCount = 1
For Each varCellCount In xlSheet.Range("BN2:BN" & lngLastRow).Cells
varCellCount.Value = Chr(35) & (varCellCount.Value)
Next

varCellCount = 1
For Each varCellCount In xlSheet.Range("BO2:BO" & lngLastRow).Cells
varCellCount.Value = Chr(35) & (varCellCount.Value)
Next

varCellCount = 1
For Each varCellCount In xlSheet.Range("BP2:BP" & lngLastRow).Cells
varCellCount.Value = Chr(35) & (varCellCount.Value)
Next

varCellCount = 1
For Each varCellCount In xlSheet.Range("EX2:EX" & lngLastRow).Cells
varCellCount.Value = Chr(35) & (varCellCount.Value)
Next

'netid and SN to ucase
varCellCount = 1
For Each varCellCount In xlSheet.Range("AC2:AC" & lngLastRow).Cells
varCellCount.Value = UCase(varCellCount.Value)
Next

varCellCount = 1
For Each varCellCount In xlSheet.Range("BW2:BW" & lngLastRow).Cells
varCellCount.Value = UCase(varCellCount.Value)
Next

varCellCount = 1
For Each varCellCount In xlSheet.Range("CQ2:CQ" & lngLastRow).Cells
varCellCount.Value = UCase(varCellCount.Value)
Next

varCellCount = 1
For Each varCellCount In xlSheet.Range("DD2D" & lngLastRow).Cells
varCellCount.Value = UCase(varCellCount.Value)
Next

varCellCount = 1
For Each varCellCount In xlSheet.Range("DZ2Z" & lngLastRow).Cells
varCellCount.Value = UCase(varCellCount.Value)
Next

'set variable for rowcount
strRange = "A1:GO" & lngLastRow

'set varible for Add/Mod
strAddModIndicater = xlSheet.Cells(3, 1).Value

'close instance of Excel
xlBook.Close savechanges:=True

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Working_HACM", strWorkingDir & "\" & strCurrentWorkbook, True, strRange

strColumnName = GetFirstColumnName("Working_HACM")

DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE * FROM Working_HACM WHERE isnull( Working_HACM." & strColumnName & ") = True;"
'added query 9/24/2008 JFH
DoCmd.RunSQL "DELETE * FROM Working_HACM WHERE Working_HACM." & strColumnName & "<> 'A' AND Working_HACM." & strColumnName & "<> 'M';"
DoCmd.SetWarnings True

'set booleen value to true, subs will change to false
blnHACMExportImportGood = True
blnProcessErrors = False

AppendHACM_Export

If blnHACMExportImportGood = False Then
'stop processing spreadsheet
MsgBox "HACM processing has stopped because of a record error!", vbOKOnly + vbExclamation, "HACM Process Halt!"
'close variables
Set fs1 = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlapp = Nothing
DoCmd.Hourglass False
Exit Do
End If

DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE HACM_Export.*, HACM_Export.AssetTag, HACM_Export.SerialNo, HACM_Export.HACM_Action" _
& " FROM HACM_Export" _
& " WHERE (((HACM_Export.AssetTag) Is Null) AND ((HACM_Export.SerialNo) Is Null)) OR (((HACM_Export.HACM_Action) Is Null));"
DoCmd.RunSQL "UPDATE HACM_Export SET HACM_Export.dAccept = [HACM_Export].[dInstall]" _
& " WHERE (((HACM_Export.dAccept) Is Null) AND ((HACM_Export.HACM_Action)='A') AND ((HACM_Export.dInstall) Is Not Null));"

DoCmd.SetWarnings True

Update_HACM_Export_Date_Formats_And_More

'set variables for HACMLog table
strTimeProcessed = Now()
strOriginalFileRecordCount = DCount("*", "HACM_Export")

'added 9/26/2008 JFH
'should never be used for Adds
If Forms!frm_ProcessHACMReserved!Frame20.Value = 3 Then 'Option button group is Skip All Validation
If strImportAction = "A" Then
'Reject
'Do not allow processing of Adds without validation.
MsgBox "Can not Disable Validation for Adds!", vbExclamation + vbYesNo, "Illegal Operation!!!"
Exit Do
End If
Else
'remove duplicates in same spreadsheet
RemoveDupsInSpreadsheet

If blnHACMExportImportGood = False Then
'stop processing spreadsheet
MsgBox "HACM processing has stopped because of a record error!", vbOKOnly + vbExclamation, "HACM Process Halt!"
'close variables
Set fs1 = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlapp = Nothing
DoCmd.Hourglass False
Exit Do
End If

'remove duplicates from prior spreadhseets
RemoveDupsFromHACM_Exports_Combined

If blnHACMExportImportGood = False Then
'stop processing spreadsheet
MsgBox "HACM processing has stopped because of a record error!", vbOKOnly + vbExclamation, "HACM Process Halt!"
'close variables
Set fs1 = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlapp = Nothing
DoCmd.Hourglass False
Exit Do
End If

'remove duplicate SN's from HACM_Export
RemoveDupSN_AC_AMASSET

If blnHACMExportImportGood = False Then
'stop processing spreadsheet
MsgBox "HACM processing has stopped because of a record error!", vbOKOnly + vbExclamation, "HACM Process Halt!"
'close variables
Set fs1 = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlapp = Nothing
DoCmd.Hourglass False
Exit Do
End If
End If

'remove invalid MODEL_TYPE from HACM Export
RemoveInvalidMODEL_TYPE_AC_AMCATREF

If blnHACMExportImportGood = False Then
'stop processing spreadsheet
MsgBox "HACM processing has stopped because of a record error!", vbOKOnly + vbExclamation, "HACM Process Halt!"
'close variables
Set fs1 = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlapp = Nothing
DoCmd.Hourglass False
Exit Do
End If

'added for mass processing of special cases 9-25-2008 JFH
'should never be used for Adds
If Forms!frm_ProcessHACMReserved!Frame20.Value = 2 Then 'Option button group is Skip Validate Fields
If strImportAction = "A" Then
'Reject
'Do not allow processing of Adds without validation.
MsgBox "Can not Disable Validation for Adds!", vbExclamation + vbYesNo, "Illegal Operation!!!"
Exit Do
End If
Else
'Validate Status and related fields, remove
ValidateHACM_Fields
End If

If blnHACMExportImportGood = False Then
'stop processing spreadsheet
MsgBox "HACM processing has stopped because of a record error!", vbOKOnly + vbExclamation, "HACM Process Halt!"
'close variables
Set fs1 = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlapp = Nothing
DoCmd.Hourglass False
Exit Do
End If

'Remove Child assets not in synq with the Parent
'do not check if Status is Record Created in Error
If Forms!frm_ProcessHACMReserved!chkAllowRetiredorConsumed.Value = 0 Then 'checkbox unchecked, default value is 0
RemoveChildParent_Out_Of_Synq
End If

If blnHACMExportImportGood = False Then
'stop processing spreadsheet
MsgBox "HACM processing has stopped because of a record error!", vbOKOnly + vbExclamation, "HACM Process Halt!"
'close variables
Set fs1 = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlapp = Nothing
DoCmd.Hourglass False
Exit Do
End If

DoCmd.SetWarnings False
'delete from table Working_HACM
DoCmd.RunSQL ("Delete * FROM HACM_Export WHERE SerialNo IN (Select Working_HACM_Process_Errors.[SerialNo] FROM Working_HACM_Process_Errors);")
DoCmd.RunSQL ("Delete * FROM HACM_Export WHERE AssetTag IN (Select Working_HACM_Process_Errors.[AssetTag] FROM Working_HACM_Process_Errors);")
DoCmd.SetWarnings True

lngCountofDupSN = DCount("*", "Working_HACM_Process_Errors")
If lngCountofDupSN > 0 Then
'process Working_HACM_Process_Errors
ExportWorking_HACM_Process_Errors_to_Excel
End If

'Populate seperate table for Location Retain added 12/5/2008 JFH
DoCmd.SetWarnings False
DoCmd.RunSQL ("INSERT INTO LocationRetain ( HACM_Action, AssetTag, eds_Client, Loca_LinkType, Loca_Value, SerialNo, Asset_Lookup_Type, EEIB_Date, Source )" _
& " SELECT 'M' AS Expr1, HACM_Export.AssetTag, HACM_Export.eds_Client, HACM_Export.Loca_LinkType, HACM_Export.Loca_Value, HACM_Export.SerialNo, HACM_Export.Asset_Lookup_Type, Format(Now(),'yyyy-mm-dd') AS Expr2, 'GMNAHACMLR' AS Expr3" _
& " FROM HACM_Export" _
& " WHERE (((HACM_Export.Status)='Deployed' Or (HACM_Export.Status)='Spare'));")
DoCmd.SetWarnings True

'Populate Table for Asset Tag mod attempt added 2/5/2009 JFH
PopulateAssetTagUpdateErrorTable

strNewName = Left(strCurrentWorkbook, Len(strCurrentWorkbook) - 4) & ".txt"
If Len(strNewName) >= 65 Then
strNewName = Trim(Right(strNewName, 64))
End If

'export as tab delim txt file with formated name and create copy of workbook in D:\FTPData\HACM_Processed\ folder
DoCmd.TransferText acExportDelim, "HACM_Export Export Specification6_2", "HACM_Export", "D:\FTPData\HACMFTP\" & strNewName, False 'HACM_GMGA-501_GMACFS_" & strTimeProcessed & ".txt", False
' Name "D:\FTPData\HACMFTP\HACM_GMGA-501_GMACFS_" & strTimeProcessed & ".txt" As "D:\FTPData\HACMFTP\" & strNewName
DoCmd.TransferSpreadsheet acExport, , "HACM_Export", "D:\FTPData\HACM_Processed\" & strCurrentWorkbook, True
' Name "D:\FTPData\HACM_Processed\HACM_GMGA-501_GMACFS_" & strTimeProcessed & ".txt" As "D:\FTPData\HACM_Processed\" & strNewName


'ftp file, if no records then do not FTP and kill file
lngCountOfHACM_Action = DCount("*", "HACM_Export")
If lngCountOfHACM_Action > 0 Then
'append to HACM_Exports_Combined Table
DoCmd.SetWarnings False
DoCmd.OpenQuery "app_HACM_Exports_Combined"
DoCmd.RunSQL "UPDATE HACM_Exports_Combined SET HACM_Exports_Combined.UserID = " & "'" & strLoginId & "'" & " WHERE isnull(HACM_Exports_Combined.UserID) = True;"
DoCmd.RunSQL "UPDATE HACM_Exports_Combined SET HACM_Exports_Combined.ProcessingTimeStamp = " & "'" & strTimeProcessed & "'" & " WHERE isnull(HACM_Exports_Combined.ProcessingTimeStamp)= True;"
DoCmd.RunSQL "UPDATE HACM_Exports_Combined SET HACM_Exports_Combined.[Original Spreadsheet Name] = " & "'" & strCurrentWorkbook & "'" & " WHERE isnull(HACM_Exports_Combined.[Original Spreadsheet Name])= True;"
DoCmd.SetWarnings True
RenameandExport_HACM_Export_File
Else
'kill file in HACM_FTP folder
Kill "D:\FTPData\HACMFTP\" & strNewName
End If

'clean up files so that they remain only in proper folders, delete table in Access
DoCmd.SetWarnings False
DoCmd.RunSQL "Delete * FROM Working_HACM;"
DoCmd.RunSQL "Delete * FROM HACM_Export;"
DoCmd.SetWarnings True
Kill strWorkingDir & "\" & strCurrentWorkbook

xlapp.DisplayAlerts = True
Set xlSheet = Nothing
Set xlBook = Nothing
xlapp.Quit
Set xlapp = Nothing
Else
blnNoFilesFound = True
If blnAnyFileFound = False Then
'close variables
Set fs1 = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlapp = Nothing
DoCmd.Hourglass False
MsgBox "Excel file not found."
Exit Sub
End If
End If
End With
Loop

DoCmd.Hourglass False

'check for files not processed
With fs1
.NewSearch
.LookIn = strWorkingDir
.FileName = strFileName
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then
MsgBox "There are " & fs1.FoundFiles.Count & " files that failed to process!", vbOKOnly + vbExclamation, "Error On FTP Process!"
Set fs1 = Nothing
Else
Set fs1 = Nothing
If blnProcessErrors = False Then
MsgBox "Process Complete."
Else
MsgBox "HACM Process Errors Found." & vbCrLf & vbCrLf & "Process Complete", vbOKOnly + vbExclamation, "HACM Process Error(s) Found in Processing"
End If
End If
End With

ErrorHandler:
Select Case Err.Number
Case 0
Resume Next
Case 20
Resume Next
Case 1004
DoCmd.Hourglass False
MsgBox "Processing Error!!!" & vbCrLf & vbCrLf _
& "Error Number is: " & Err.Number & vbCrLf & vbCrLf _
& "Error Description is: " & Err.Description & vbCrLf & vbCrLf _
& "Excel Spreadsheet: " & strCurrentWorkbook & vbCrLf & vbCrLf _
& "If error is regarding insert of rows." & vbCrLf & vbCrLf & vbCrLf & vbCrLf _
& "Insert new sheet into spreadsheet." & vbCrLf & vbCrLf _
& "Make sure new sheet is the first sheet in workbook and rerun." & vbCrLf & vbCrLf _
& "Copy/Paste data only inluding the Header row into new worksheet, save and rerun.", vbOKOnly, "AssetCenterOutput_Spreadsheets Error"
Set fs1 = Nothing
Set xlSheet = Nothing
' xlBook.Close savechanges:=False
Set xlBook = Nothing
xlapp.Quit
Set xlapp = Nothing
DoCmd.SetWarnings True
Case Else
DoCmd.Hourglass False
MsgBox "Please record the Error Number and Description" & vbCrLf & vbCrLf _
& "Error Number is " & Err.Number & vbCrLf & vbCrLf _
& "Error Description is " & Err.Description & vbCrLf & vbCrLf _
& "Excel Spreadsheet: " & strCurrentWorkbook, vbOKOnly, "AssetCenterOutput_Spreadsheets Error"
Set fs1 = Nothing
Set xlSheet = Nothing
' xlBook.Close savechanges:=False
Set xlBook = Nothing
xlapp.Quit
Set xlapp = Nothing
DoCmd.SetWarnings True
End Select

End Sub

I have stepeed through it and that is where ther error occurs.

 

[RoyVidar]

> The submitter has done something to the spreadsheet I can't figure out.

To which I suggested that he has added information to the bottom/last row of the worksheet (row 65 536 if 2003 or earlier version). Then Excel isn't able to add another row, because that would mean the last row shifts off the worksheet -> RT 1004.

Roy-Vidar

 

[SkipVought]

I try to avoid using INSERT, and instead add data to the bottom of an Excel table and then SORT into order, if necessary.

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[RoyVidar]

Some other comments

I don't use application.filesearch. One of the reason, is I find it unpredictable and buggy, which is perhaps why it's removed from Office 2007, which might also be a good reason to look in other directions.

Now, here, you're instantiating it also per each iteration of your loop, which I'm not sure is good.

I'd rather recommend taking a look at for instance the Dir() function, which should work nicely here, too.

You're also instantiating Excel once per iteration, which I'll also recommend against. Do it either once outside the loop, or ensure it isn't reinstantiated per each iteration, say with

If xlapp Is Nothing Then
Set xlapp = CreateObject("Excel.Application")
End If

Since you're reinstantiating workbook and worksheet variables per each iteration, I think I'd release at least the workbook object variable AND you might also test whether adding a DoEvents helps

xlBook.Close savechanges:=True
set xlBook = Nothing
DoEvents ' mayhaps?

I see you've commented the declaration of strCurrentWorkbook - but you still use it umpteen times through the code. Is it a module level or global variable, or are you programming without your seatbelts (without the statement Option Explicit at the top of each module)?

I think perhaps also a rewrite could be in place, not that I want to try ;-) but some of this stuff, might execute faster whith a bit of rewrite, I think. You do some selections, which I don't think is necessary, and I'm sure PHV and SkipVought have some methods to reduce some of the looping and Excel specifics.

Roy-Vidar

 

[joel009]

Sorry, work and then the weekend got in the way. Thank you for your responses.

Skip _ please expound. If I sort the header row gets mixed into the data. I guess I could delete it first and then not include it????

Roy-Vidar - good catch on the opening of the Excel instance. Speed is a consideration always and I am always open to suggestions.

I do run my apps I develope with my modules all option explicit on each module - too crazy without it.

I made strCurrentWorkbook a Global variable and I did not include a comment.

I use the Filesearch as I delete each file from the sourch folder in each loop and wanted to refresh the list. I will take a look at the Dir().

As to "Since you're reinstantiating workbook and worksheet variables per each iteration, I think I'd release at least the workbook object variable AND you might also test whether adding a DoEvents helps

xlBook.Close savechanges:=True
set xlBook = Nothing
DoEvents ' mayhaps?"

I see the benifit of releasing the oject xlBook but not the DoEvents?

Please let me know, I am open to suggestions.

 

[RoyVidar]

Should perhaps been between the close and release.

The idea is to allow the workbook to fully close before processing. I'd try it if the other stuff doesn't work ;-)

Roy-Vidar

 

[SkipVought]

If I sort the header row gets mixed into the data. [/quote[
Change xlGuess to xlYes.

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[joel009]

Skip - What I receive is an Excel template that is supposed to be limited to 500 rows that I process through my Access db and then FTP the finished product (tab deliminated CSV field). The submitters (I think) copy paste whole sheets. Even though the template is formated to allow only 500 records the 65K+ rows get pasted in. The only column I am interested in is A, if it has data in it should be valid.

How can I sort and delete all rows with column A empty?
If I do this manually it still does not work in Access, I need to copy/paste the data into a new sheet in the same workbook and then it will work.

I may need to rewrite the Excel handling but am not sure.

Thanks Joel

 

[SkipVought]

What I receive is an Excel template that is supposed to be limited to 500 rows...Even though the template is formated to allow only 500 records the 65K+ rows get pasted in.

Each and every Excel worksheet in that version, will have 65,536 rows.

As I stated earler, in your SORT statement, change xlGuess to xlYes, and your heading will not sort. You did not post any SORT code, so I can't see what you are doing there.


Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}