Solved

MS Access VBA to include Access Table field

Posted on 2013-05-16
16
956 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
  • 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
 
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
Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 
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

Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

Join & Write a Comment

Overview: This article:       (a) explains one principle method to cross-reference invoice items in Quickbooks®       (b) explores the reasons one might need to cross-reference invoice items       (c) provides a sample process for creating a M…
A simple tool to export all objects of two Access files as text and compare it with Meld, a free diff tool.
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

757 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

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now