Improve company productivity with a Business Account.Sign Up

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1087
  • Last Modified:

MS Access VBA to include Access Table field

Hello Experts,

I am trying to read in an ACCESS Table field but my attempt delivers the message, “Sub or Function not defined“.  Funny, it excepts the first ACCESS field (SpreadsheetName).  Below displays the problem and the code.

              Set shtToCopy = wkbSource.Sheets(rs("SSTab"))

And the VBA:
Private Sub TestCopy_Click()
Dim wkbSource As Workbook
Dim wkbDest As Workbook
Dim shtToCopy As Worksheet
Dim rs As Recordset
Dim xl As Object
Dim SpreadsheetName As String
Dim SSTab As String
Dim ID As Field

Set xl = CreateObject("Excel.Application")
xl.Visible = True
Set rs = CurrentDb.OpenRecordset("TblReports")

Do While Not (rs.EOF)
    Set wkbSource = xl.Workbooks.Open(rs("SpreadsheetName"))
    Set wkbDest = xl.Workbooks.Open("H:\PDF\MasterReport88.xlsx")
        'Makes a copy of "Sheet1"
    Set shtToCopy = wkbSource.Sheets(rs("SSTab"))           'Sheets("Output 1")  Sheets(rs("SSTab"))
    shtToCopy.Copy wkbDest.Sheets(1)
       
           'Closes "wkbDest" workbook and saves the copied sheeet
    wkbSource.Close False
  rs.MoveNext
Loop

wkbDest.Close SaveChanges:=True
Set wkbSource = Nothing
Set wkbDest = Nothing

    Beep
    MsgBox "Worksheet was copied"

End Sub
0
CFMI
Asked:
CFMI
  • 7
  • 7
  • 2
2 Solutions
 
omgangIT ManagerCommented:
Try

Set rs = CurrentDb.OpenRecordset("TblReports")

rs.MoveFirst

Do While Not (rs.EOF)


OM Gang
0
 
CFMIFinancial Systems AnalystAuthor Commented:
This modification presents the message, "Run-time error 13", Type mismatch" and points to the same code:
          Set shtToCopy = wkbSource.Sheets(rs("SSTab"))
0
 
omgangIT ManagerCommented:
I'm getting the same error as you.  Apparently we can't pass a sheet name for the argument.  Works with sheet index value.
Working on it.
OM Gang


Public Function TestExcel()

On Error GoTo Err_TestExcel

    Dim xl As New Excel.Application
    Dim wkbSource As Workbook
    Dim wkbDest As Workbook
    Dim shtToCopy As Worksheet
   
    Dim rs As DAO.Recordset
    Set rs = CurrentDb.OpenRecordset("tblExcel")
    rs.MoveFirst
   
    Set wkbSource = xl.Workbooks.Open(rs("Workbook"))
    Debug.Print wkbSource.Name
   
    'Set shtToCopy = wkbSource.Worksheets(rs("Worksheet"))
    'Set shtToCopy = wkbSource.Sheets(rs("Worksheet"))
    Set shtToCopy = wkbSource.Sheets(1)
    Debug.Print shtToCopy.Name

   

Exit_TestExcel:
    Set shtToCopy = Nothing
    Set wkbSource = Nothing
    Set xl = Nothing
    Exit Function

Err_TestExcel:
    MsgBox Err.Number & " (" & Err.Description & ") in procedure TestExcel of Module Module9"
    Resume Exit_TestExcel

End Function
0
What Kind of Coding Program is Right for You?

There are many ways to learn to code these days. From coding bootcamps like Flatiron School to online courses to totally free beginner resources. The best way to learn to code depends on many factors, but the most important one is you. See what course is best for you.

 
omgangIT ManagerCommented:
Not elegant and I'm not sure what we're missing but this works
OM Gang

Public Function TestExcel()

On Error GoTo Err_TestExcel

    Dim xl As New Excel.Application
    Dim wkbSource As Workbook
    Dim wkbDest As Workbook
    Dim shtToCopy As Excel.Worksheet
    Dim i As Integer
   
    Dim rs As DAO.Recordset
    Set rs = CurrentDb.OpenRecordset("tblExcel")
    rs.MoveFirst
   
    Set wkbSource = xl.Workbooks.Open(rs("Workbook"))
    Debug.Print wkbSource.Name
   
    'Set shtToCopy = wkbSource.Worksheets(rs("Worksheet"))
    'Set shtToCopy = wkbSource.Sheets(rs("Worksheet"))
    'Set shtToCopy = wkbSource.Sheets(1)
   
    For i = 1 To wkbSource.Worksheets.Count
        If wkbSource.Worksheets(i).Name = rs("Worksheet") Then
            Set shtToCopy = wkbSource.Worksheets(i)
        End If
    Next i
   
    Debug.Print shtToCopy.Name

Exit_TestExcel:
    Set shtToCopy = Nothing
    Set wkbSource = Nothing
    Set xl = Nothing
    Exit Function

Err_TestExcel:
    MsgBox Err.Number & " (" & Err.Description & ") in procedure TestExcel of Module Module9"
    Resume Exit_TestExcel

End Function
0
 
IrogSintaCommented:
Have you tried
Set shtToCopy = wkbSource.Sheets(rs("SSTab")).Sheet
0
 
CFMIFinancial Systems AnalystAuthor Commented:
Just tried:
 Set shtToCopy = wkbSource.Sheets(rs("SSTab")).Sheet
and received an error message, :"Type Mismatch"
0
 
omgangIT ManagerCommented:
@CFMI, have you tried the solution/work around I suggested?
OM Gang
0
 
CFMIFinancial Systems AnalystAuthor Commented:
Hello,
I am using your code but receiving an error message, "3265 (Item not found in this collection.) in procedure TestExcel of Module Module9".  Unfortunately, I was just pulled to handle a higher priority and will try again on Monday - have a great weekend!
0
 
omgangIT ManagerCommented:
OK
0
 
IrogSintaCommented:
I tried this out.  As omgang mentioned, it won't work when passing the field as the argument but it does work if you assign the field first to a string variable like so:

Dim shtName as String

shtName = rs!SSTab   
Set shtToCopy = wkbSource.Sheets(shtName)

Open in new window

You can use rs!SSTab or rs("SSTab") but my preference is to use the ! sign for simplicity.
0
 
omgangIT ManagerCommented:
Interesting.  I hadn't thought to try that (assign the value to a variable first).  Good find.
OM Gang
0
 
CFMIFinancial Systems AnalystAuthor Commented:
So close, no errors but the sheet isn't copied even with the message appearing, "Worksheet was copied".  Also, when I open the spreadsheet, "MasterReport88.xlsx", a Read/Write message appears.

On Error GoTo Err_TestExcel
    Dim xl As New Excel.Application
    Dim wkbSource As Workbook
    Dim wkbDest As Workbook
    Dim shtToCopy As Excel.Worksheet
    Dim i As Integer
    Dim shtName As String
    Dim SSName As String
    Dim SSTab As String
    Dim rs As DAO.Recordset
   
    Set rs = CurrentDb.OpenRecordset("TblReports")
    rs.MoveFirst
   
    Set wkbSource = xl.Workbooks.Open(rs("SSName"))
    shtName = rs!SSTab
    Debug.Print wkbSource.Name
   
    Set wkbDest = xl.Workbooks.Open("H:\PDF\MasterReport88.xlsx")
   
    Do While Not (rs.EOF)
    Set wkbSource = xl.Workbooks.Open(rs("SSName"))
    shtName = rs!SSTab
    Set shtToCopy = wkbSource.Sheets(shtName)           'Makes a copy of "Sheet1"
    shtToCopy.Copy wkbDest.Sheets(1)
       
  rs.MoveNext
Loop
       
    Debug.Print shtToCopy.Name
   
Exit_TestExcel:
           'Closes "wkbDest" workbook and saves the copied sheeet
    wkbSource.Close False
    Set wkbDest = Nothing
    Set shtToCopy = Nothing
    Set xl = Nothing
       
Beep
    MsgBox "Worksheet was copied"
    Exit Sub

Err_TestExcel:
    MsgBox Err.Number & " (" & Err.Description & ") in procedure TestExcel of Module Module9"
    Resume Exit_TestExcel
0
 
omgangIT ManagerCommented:
Try
    shtToCopy.Copy After:=wkbSource.Sheets(wkbSource.Sheets.Count)


The Excel Worksheet.Copy command creates a copy and places it in a location.  It doesn't accept a sheet name for an argument but, instead, and index of where we want to place it.  My example places the copy after the last workseet in the list.

OM Gang
0
 
CFMIFinancial Systems AnalystAuthor Commented:
Unfortunately, no worksheets are copied into the destination, "MasterReport88.xlsx".
0
 
CFMIFinancial Systems AnalystAuthor Commented:
Experts,

The below code displays the final spreadsheet, “MasterReport88.xlsx” with all of the worksheets copied however when I attempt to save the file an error message appears, “Errors were detected while saving H:\PDF\MasterReport88.xlsx.  Microsoft Excel may be able to save the file by removing or repairing some features. To make the repair in a new file, click continue.  To cancel saving the file, click.

The save never happens so I manually selected save as and it saved PERFECT with a xls extension - this is great but I am not sure about the saveas code; I tried: wkbDest.SaveAs "H:\PDF\MasterReport.xls" but that didn't work.  Please share suggestions.

Private Sub TestCopy_Click()
Dim xl As New Excel.Application
Dim wkbSource As Workbook
Dim wkbDest As Workbook
Dim shtToCopy As Excel.Worksheet
Dim rs As Recordset
Dim SSName As String
Dim SSTab As String
Dim shtName As String
Set xl = CreateObject("Excel.Application")
xl.Visible = True
Set rs = CurrentDb.OpenRecordset("TblReports")
rs.MoveFirst
Set wkbDest = xl.Workbooks.Open("H:\PDF\MasterReport88.xlsx")
Do While Not (rs.EOF)
    shtName = rs!SSTab
    Set wkbSource = xl.Workbooks.Open(rs("SSName"))
    Set shtToCopy = wkbSource.Sheets(shtName)           'Sheets("Output 1")  Sheets(rs("SSTab"))
    shtToCopy.Copy After:=wkbSource.Sheets(wkbSource.Sheets.Count)
        Set shtToCopy = wkbSource.Sheets(shtName)           'Makes a copy of "Sheet1"
    shtToCopy.Copy wkbDest.Sheets(1)
    Set shtToCopy = wkbSource.Sheets(shtName)
    wkbSource.Close False
  rs.MoveNext
Loop
wkbDest.SaveAs "H:\PDF\MasterReport.xls"
wkbDest.Close SaveChanges:=True
Set wkbSource = Nothing
Set wkbDest = Nothing
    Beep
    MsgBox "Worksheet was copied"

End Sub
0
 
CFMIFinancial Systems AnalystAuthor Commented:
The provided code allowed using a MS Access Table to insert workbook names and worksheet titles.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 7
  • 7
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now