Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

VBA in Access to replace excel sheet content

Status
Not open for further replies.

jackyzsn

Programmer
May 17, 2007
14
CA
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:
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
 
Your code reference a sheet you've just deleted !

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
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?
 
...
[!]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
 
OK, I revised my code into following, in Access:
Code:
                 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:
Code:
    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....
 
No one? I think that might be a bug of office..

In Access:
Code:
  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:
Code:
  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..
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top