VBA in Access to replace excel sheet content

[jackyzsn]

Hi,

I'm trying to use VBA in access to open an excel spreadsheet, replace some content, and copy to another spreadsheet. The repace code works fine in Excel, but if I put it in access, I got "Subscript out of range", Here is the code:

    Set oXL = CreateObject("Excel.Application")
            
    oXL.DisplayAlerts = False
    oXL.ScreenUpdating = False

    Set objFSOctl = CreateObject("UserAccounts.CommonDialog")
    objFSOctl.Filter = "Excel File(*.xls)|*.xls|All Files|*.*"
    objFSOctl.FilterIndex = 3
    objFSOctl.Flags = &H80000 + &H4 + &H8
    InitFSOctl = objFSOctl.ShowOpen
    
    If InitFSOctl Then
        openFilename = objFSOctl.fileName
        strPosTmp1 = InStrRev(openFilename, "\")
        currDirStr = Left(openFilename, strPosTmp1)
        openFileStr = Right(openFilename, Len(openFilename) - strPosTmp1)
        strPosTmp1 = InStr(openFileStr, ".")
        wrkTmpStr = Left(openFileStr, strPosTmp1 - 1)
    
        Set objFSO = CreateObject("SAFRCFileDlg.FileSave")
        objFSO.FileType = "Excel file(*.xls)"
        objFSO.fileName = currDirStr & wrkTmpStr & "_changed.xls"
        InitFSO = objFSO.OpenFileSaveDlg
    
        If InitFSO Then
            outfilename = objFSO.fileName
            strPosTmp1 = InStrRev(outfilename, "\")
            saveDirStr = Left(outfilename, strPosTmp1)
            
            Set srcWorkbook = oXL.Workbooks.Open(openFilename)
            If Err.Number = 0 Then
                oXL.Workbooks.Add
                oXL.ActiveWorkbook.Sheets("Sheet1").Delete
                oXL.ActiveWorkbook.Sheets("Sheet2").Delete
                
                Dim i As Integer
                i = 1
                For Each w In srcWorkbook.Worksheets
                    w.Copy , oXL.ActiveWorkbook.Worksheets(i)
                     oXL.ActiveWorkbook.Worksheets("Sheet1").Cells.Replace What:="NULL", _
                     Replacement:=Null, LookAt:=xlPart, _ 
                     SearchOrder:=xlByRows, MatchCase:=False   '<== got run time error here, _
                     no problem if in Excel
                    i = i + 1
                Next w

                oXL.ActiveWorkbook.Sheets("Sheet3").Delete
                oXL.ActiveWorkbook.SaveAs outfilename
                oXL.ActiveWorkbook.Close
            End If
            srcWorkbook.Close
        End If
    End If
    oXL.ScreenUpdating = True
    oXL.DisplayAlerts = True
    Set oXL = Nothing

 

[PHV]

Your code reference a sheet you've just deleted !

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

 

[jackyzsn]

Are you sure? I add watch to debug it, after the code 'w.copy...', I'm able to see the 'oXL.activeworkbook' object... would you please explain a little bit in detail?

 

[PHV]

...
[!]oXL.ActiveWorkbook.Sheets("Sheet1").Delete[/!]
oXL.ActiveWorkbook.Sheets("Sheet2").Delete

Dim i As Integer
i = 1
For Each w In srcWorkbook.Worksheets
w.Copy , oXL.ActiveWorkbook.Worksheets(i)
[!]oXL.ActiveWorkbook.Worksheets("Sheet1").Cells.Replace[/!] What:="NULL", _
Replacement:=Null, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
...

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

 

[jackyzsn]

OK, I revised my code into following, in Access:

                 For Each w In srcworkbook.Worksheets
                    w.Cells.Replace What:="NULL", Replacement:=Null, LookAt:=xlPart, _
                    SearchOrder:=xlByRows, MatchCase:=False
                    i = i + 1
                Next w

                srcworkbook.Save
                srcworkbook.Close
            End If

Not working, run time error 9, same as above.

In Excel:

    For Each w In ThisWorkbook.Worksheets
        w.Cells.Replace What:="NULL", Replacement:=Null, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
        i = i + 1
    Next w
    ThisWorkbook.Save

Works fine....

 

[jackyzsn]

No one? I think that might be a bug of office..

In Access:

  For Each w In srcWorkbook.Worksheets
      'w.Cells.Replace What:="NULL", Replacement:=Null, LookAt:=xlPart, _
      SearchOrder:=xlByRows, MatchCase:=False
      w.Copy , oXL.ActiveWorkbook.Worksheets(i)
      oXL.Visible = True
      Set desWorkBook = oXL.ActiveWorkbook
      desWorkBook.Sheets(w.Name).Visible = True
      MsgBox desWorkBook.Sheets(w.Name).Cells(1, 1) <==OK here, display the right cell
      Set wkRange = desWorkBook.Sheets(w.Name).Cells("A1:D10") 
      With wkRange
          '.Select
          .Replace What:="NULL", Replacement:=Null, LookAt:=xlPart, _
          SearchOrder:=xlByColumn, MatchCase:=False <== Runtime '9', subscript out of...
      End With
      i = i + 1
  Next w

Following Code works fine in Excel VBA:

  For Each w In srcWorkbook.Worksheets
      'w.Cells.Replace What:="NULL", Replacement:=Null, LookAt:=xlPart, _
      SearchOrder:=xlByRows, MatchCase:=False
      w.Copy , ActiveWorkbook.Worksheets(i)
      'oXL.Visible = True
      Set desWorkBook = ActiveWorkbook
      desWorkBook.Sheets(w.Name).Visible = True
      'MsgBox desWorkBook.Sheets(w.Name).Cells(1, 1)
      desWorkBook.Sheets(w.Name).Cells.Replace What:="NULL", Replacement:=Null, LookAt:=xlPart, _
      SearchOrder:=xlByRows, MatchCase:=False
      i = i + 1
  Next w

If somebody can confirm that's a bug then I can forget about Access and do it in Excel..