Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

MS Access VBA to include Access Table field

Posted on 2013-05-16
16
Medium Priority
?
1,059 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
Enterprise Mobility and BYOD For Dummies

Like “For Dummies” books, you can read this in whatever order you choose and learn about mobility and BYOD; and how to put a competitive mobile infrastructure in place. Developed for SMBs and large enterprises alike, you will find helpful use cases, planning, and implementation.

 
LVL 28

Assisted Solution

by:omgang
omgang earned 750 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 750 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

On Demand Webinar: Networking for the Cloud Era

Did you know SD-WANs can improve network connectivity? Check out this webinar to learn how an SD-WAN simplified, one-click tool can help you migrate and manage data in the cloud.

Question has a verified solution.

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

This article describes a serious pitfall that can happen when deleting shapes using VBA.
If you need a simple but flexible process for maintaining an audit trail of who created, edited, or deleted data from a table, or multiple tables, and you can do all of your work from within a form, this simple Audit Log will work for you.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.
Visualize your data even better in Access queries. Given a date and a value, this lesson shows how to compare that value with the previous value, calculate the difference, and display a circle if the value is the same, an up triangle if it increased…

715 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