Solved

MS Access VBA to include Access Table field

Posted on 2013-05-16
16
1,026 Views
Last Modified: 2013-05-21
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
Comment
Question by:CFMI
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 7
  • 7
  • 2
16 Comments
 
LVL 28

Expert Comment

by:omgang
ID: 39172283
Try

Set rs = CurrentDb.OpenRecordset("TblReports")

rs.MoveFirst

Do While Not (rs.EOF)


OM Gang
0
 
LVL 1

Author Comment

by:CFMI
ID: 39172326
This modification presents the message, "Run-time error 13", Type mismatch" and points to the same code:
          Set shtToCopy = wkbSource.Sheets(rs("SSTab"))
0
 
LVL 28

Expert Comment

by:omgang
ID: 39172489
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
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 28

Assisted Solution

by:omgang
omgang earned 250 total points
ID: 39172527
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
 
LVL 29

Expert Comment

by:IrogSinta
ID: 39173388
Have you tried
Set shtToCopy = wkbSource.Sheets(rs("SSTab")).Sheet
0
 
LVL 1

Author Comment

by:CFMI
ID: 39174681
Just tried:
 Set shtToCopy = wkbSource.Sheets(rs("SSTab")).Sheet
and received an error message, :"Type Mismatch"
0
 
LVL 28

Expert Comment

by:omgang
ID: 39174922
@CFMI, have you tried the solution/work around I suggested?
OM Gang
0
 
LVL 1

Author Comment

by:CFMI
ID: 39175938
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
 
LVL 28

Expert Comment

by:omgang
ID: 39175944
OK
0
 
LVL 29

Accepted Solution

by:
IrogSinta earned 250 total points
ID: 39176494
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
 
LVL 28

Expert Comment

by:omgang
ID: 39181131
Interesting.  I hadn't thought to try that (assign the value to a variable first).  Good find.
OM Gang
0
 
LVL 1

Author Comment

by:CFMI
ID: 39181682
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
 
LVL 28

Expert Comment

by:omgang
ID: 39181824
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
 
LVL 1

Author Comment

by:CFMI
ID: 39182253
Unfortunately, no worksheets are copied into the destination, "MasterReport88.xlsx".
0
 
LVL 1

Author Comment

by:CFMI
ID: 39184275
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
 
LVL 1

Author Closing Comment

by:CFMI
ID: 39184776
The provided code allowed using a MS Access Table to insert workbook names and worksheet titles.
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
As tax season makes its return, so does the increase in cyber crime and tax refund phishing that comes with it
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

734 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question