I have an export process that transfers data from my Access tables to an Excel File. A couple times I have had issues where the process didn't generate one or more of the sheets (1 sheet = 1 table) in Excel. So when the transfers are complete I want Access to check if all the sheets are located in the Excel file. I have most of the Check process worked out all I need now is a way to "read" the sheet names from the Excel File in to a table. How can I read the Sheet name (not the data)?
From Access you can automate Excel, open the workbook file, and read the sheet names from the Worksheets collection.
This sample uses late binding. If you prefer early binding, add a reference for Microsoft Excel [version] Object Library and enable the "early" lines instead of the "late" lines.
Give the procedure the full path to your workbook file as its pWorkBook parameter.
Public Sub List_worksheets(ByVal pWorkBook As String)
'Dim objExc As Excel.Application ' early
'Dim objWbk As Excel.Workbook ' early
'Dim objWsh As Excel.Worksheet ' early
Dim objExc As Object ' late
Dim objWbk As Object ' late
Dim objWsh As Object ' late
'Set objExc = New Excel.Application ' early
Set objExc = CreateObject("Excel.Application") ' late
Set objWbk = objExc.Workbooks.Open(pWorkBook)
For Each objWsh In objWbk.Worksheets
Debug.Print objWsh.Name
Next
Set objWsh = Nothing
objWbk.Close
Set objWbk = Nothing
objExc.Quit
Set objExc = Nothing
End Sub
In Access 2007, You can use OpenDatabase method to do this:
Private Sub Command1_Click()
Set db = OpenDatabase("c:/123.xls", True, False, "Excel 5.0")
For Each tbl In db.TableDefs
MsgBox tbl.Name
Next
End Sub
Related
I have adapted code that checks the subject line of new Outlook emails for a keyword, opens a workbook and pastes certain information into this workbook:
Option Explicit
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
' default local Inbox
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
If InStr(Msg.Subject, "Re:") > 0 Then
Exit Sub
ElseIf InStr(Msg.Subject, "MDI Board") > 0 Then '// Keyword goes here
'// Declare all variables needed for excel functionality and open appropriate document
Dim oXL As Object
Dim oWS As Object
Dim lngRow As Long
Set oXL = CreateObject("Excel.Application")
oXL.Workbooks.Open FileName:="T:\Capstone Proj\TimeStampsOnly.xlsx", AddTOMRU:=False, UpdateLinks:=False
'// Change sheet name to suit
Set oWS = oXL.Sheets("TimeStamps")
lngRow = oWS.Range("A" & oXL.Rows.Count).End(-4162).Offset(1).Row '// -4162 = xlUp. not available late bound
With oWS
.cells(lngRow, 1).Value = Msg.SenderName
.cells(lngRow, 2).Value = Msg.ReceivedTime
.cells(lngRow, 3).Value = Msg.ReceivedByName
.cells(lngRow, 4).Value = Msg.Subject
.cells(lngRow, 5).Value = Msg.Body
'// And others as needed - you will have Intellisense
End With
With oXL
.activeworkbook.Save
.activeworkbook.Close SaveChanges:=2 '// 2 = xlDoNotSaveChanges but not availabe late bound
.Application.Quit
End With
Set oXL = Nothing
Set oWS = Nothing
End If
Else
Exit Sub
End If
ExitPoint:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ExitPoint
'// Debug only
Resume
End Sub
I was having issues with being able to access the workbook after the Outlook VBA code ran. It would give multiple errors such as 'the workbook is already open' even though I had no instance of Excel running on my machine or 'this file is read-only' etc.
I tried to circumvent this issue by using another workbook with an update macro that would update a dashboard using the information in the problematic workbook however I am getting a 'subscript out of range' error when I try to set a variable to the workbook with the Outlook data.
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Set wkb = Excel.Workbooks("T:\Capstone Proj\TimeStampsOnly.xlsx")
Set wks = wkb.Worksheets("Timestamps")
Wagner Braga!
I have had a similar problem in the past. In my case, I was not looking for subjects containing certain characters but rather subjects equal to a string. Either way, that is irrelevant to your issue.
I found that, like yours, my code errored when trying to put info from the email into Excel. I did read the comments on your question and know that you don't want to use unneccessary computing power. My method is not the most efficient way to accomplish what you want to do, but it was the only way I could do it.
First of all, I did not edit the Excel workbook from the Outlook VBA. I tried to do it, but this is where my code errored. Instead, I set the email object as a variable's value (to make it easier to reference). Then I read the information from the email I wanted into an array by using the Split(...) function. The code created a text file and wrote the data to it so that it would be accessible by Excel. Before writing the data from the email, I also wrote the text "!NEWDATA!" on the first line. You could use any string you want, as long as there is a unique identifier at the top so that Excel recognizes that it should get data from the file. I then opened the workbook, just like I would open any other file using VBA.
Now, the Excel workboook requires some VBA code as well for my method to work. In the Workbook_Open() VBA sub in the workbook code, Excel should read the first line or first x number of characters. You can use either method, but this is should point to the part of the file that has your "!NEWDATA!" or other string. If this string is the one you wrote from Outlook, continue reading the file. If it's not, Exit Sub. From here you can have Excel read the rest of the file (which you separated by a delimeter of your choice via Outlook VBA) and put the data into the corresponding cells. Then change the "!NEWDATA!" and the rest of the file so that if you start Excel manually (and you don't want to import any data) the Workbook_Open() sub will stop and not error. You can change it to anything like a blank file, "No new data", or any other string you like. After this, use VBA to save the workbook and close it.
As you probably know, you could set the Excel window's Visible property to False if you don't want the user seeing the workbook.
If you have any questions or comments, let me know. I'll be happy to answer any questions you may have.
I need to use VBScript to change all of the sheets in an excel workbook to Page Layout View instead of the default view. However, I cannot figure out how to do that in VBS. With VBA, the code I've been using (with a while loop to go over each sheet) is
With ActiveWindow
.View = xlPageLayoutView
End With
which serves my purposes fine. But I need to do this in VBS. I think it has something to do with the Application object, though I'm not sure. Any help would be appreciated.
Edit: here's a sample of the code I've written with declarations and things. It's basically iterating over a number of sheets in a workbook and setting them all (or trying to) to Page Layout view. Missing from this segment is the sub where I populate the workbook with new sheets matching the entries from Names().
Dim destFile, objWorkbook
Set destFile = CreateObject("Excel.Application")
Set objWorkbook = destFile.Workbooks.Add()
objWorkBook.SaveAs(strPath)
Sub OverNames()
For i = 1 to 9
SetPagelayout(i)
Next
End Sub
Sub SetPageLayout(hNum)
Dim houseSheet, sheetName
'retrieves sheet name from array Names()
sheetName = Names(hNum, 0)
Set houseSheet = destFile.Worksheets(sheetName)
houseSheet.Window.View = xlPageLayoutView
End Sub
VBA already has excel and the workbook loaded. With VBS, you need to create an excel object and open your workbook with it. Also, VBA has static variables defined for excel settings, which you will have to define yourself in VBS.
Dim objExcel
Dim excelPath
Dim xlPageLayoutView=3 ' https://msdn.microsoft.com/en-us/library/office/ff838200.aspx
excelPath = "C:\scripts\servers.xlsx"
objExcel.DisplayAlerts = 0
Set objExcel = CreateObject("Excel.Application")
In order to change the state of a window, you have to access the window object. In excel there are Workbooks, which contain collections of Worksheets and Windows. The application also contains a collection of all windows in all worksheets. In the workbook window collection, the active window is always accessed through index 1.
Set currentWorkBook = objExcel.ActiveWorkbook
Set currentWorkSheet = currentWorkBook.Worksheets("Sheet Name Here")
currentWorkSheet.Activate
Set currentWindow = currentWorkBook.Windows(1)
currentWindow.View = xlPageLayoutView
I'm trying to create an Excel file from an Access database. I need to create some conditional formatting in the excel file. I save the file, but when I re-open the file a warning message Unreadable content is shown and, even repairing, the conditional formatting is lost.
I tried many options and read a lot of posts but none solving this issue.
This is involved part of the code:
'==========================================================================
Dim xl As Excel.Application
Dim wk3 As Workbook
Dim ws3 As Worksheet
Set xl = New Excel.Application ' Create a excel instance
Set wk3 = xl.Workbooks.Add ' Create a new workbook
Set ws3 = wk3.Worksheets(1) ' Add a worksheet to the new wrkbk
...
'
' Add conditional formatting to a range
'
ws3.Range("A1:A10").FormatConditions.Add xlCellValue, xlEqual, "=TRUE"
ws3.Range("A1:A10").FormatConditions(1).Interior.Color = vbGreen
'
' Save and close file
'
wk3.SaveAs "D:\_TOOLS\Result.xlsx" ' Save as Excel 2010 file
wk3.Close False ' Close file
'
' Close excel and free memory
'
Set wk3 = Nothing
Set ws3 = Nothing
xl.Quit
Set xl = Nothing
'==========================================================================
My office version is 2010 (ver. 14.0.6112.5000 32bit). I tried many saving formats but some of them hang Access (like xlExcel12). Some of the others give an incompatibility error with extension during saving (like xlExcel8).
Any suggestions?
You might want to try xlWorkbookNormal (value -4143) as the save format which is the Excel default (explicitly).
However, I have seen similar issues pop up when you are explicitly referencing Excel object in your code (i.e. Excel Library 14.0 is selected in the "References" of the VBA project).
The solution which has worked for me is to remove the "Excel Library" Reference and late-bound the object instead:
Dim xl As Object, wk3 As Object, ws3 As Object
' Create Excel object based on version installed on the machine (late bound).
Set xl = CreateObject("Excel.Application")
' Rest of your code can remain unchanged...
wk3.SaveAs "D:\_TOOLS\Result.xlsx", -4143 ' -4143 = xlWorkbookNormal
The downside to this during development is you will lose intellisence. So what you can do is keep the early-bound objects for development purposes, but comment them out for deployment (and vice-versa):
' Keep these for development.
' These require the Excel Library to be explicitly referenced.
'Dim xl As Excel.Application
'Dim wk3 As Workbook
'Dim ws3 As Worksheet
'Set xl = New Excel.Application ' Create a excel instance
' Use for deployment.
' Remove the Excel Library reference to use this section.
Dim xl As Object, wk3 As Workbook, ws3 As Worksheet
' Create Excel object based on version installed on the machine (late bound).
Set xl = CreateObject("Excel.Application")
' Rest of your code can remain unchanged...
wk3.SaveAs "D:\_TOOLS\Result.xlsx", -4143 ' -4143 = xlWorkbookNormal
I'm attempting to copy the contents of a text box from one workbook to another. I have no problem copying cell values from the first workbook to the 2nd, but I get an object required error when I attempt to copy the text box. This macro is being run from the workbook containing the data I want copied. Using Excel 2007 Code:
Sub UploadData()
Dim xlo As New Excel.Application
Dim xlw As New Excel.Workbook
Set xlw = xlo.Workbooks.Open("c:\myworkbook.xlsx")
xlo.Worksheets(1).Cells(2, 1) = Range("d4").Value 'Copy cell content (this works fine)
xlo.Worksheets(1).Cells(2, 2) = TextBox1.Text 'This gives me the object required error
xlw.Save
xlw.Close
Set xlo = Nothing
Set xlw = Nothing
End Sub
Thanks for any help.
The problem with your macro is that once you have opened your destination Workbook (xlw in your code sample), it is set as the ActiveWorkbook object and you get an error because TextBox1 doesn't exist in that specific Workbook. To resolve this issue, you could define a reference object to your actual Workbook before opening the other one.
Sub UploadData()
Dim xlo As New Excel.Application
Dim xlw As New Excel.Workbook
Dim myWb as Excel.Workbook
Set myWb = ActiveWorkbook
Set xlw = xlo.Workbooks.Open("c:\myworkbook.xlsx")
xlo.Worksheets(1).Cells(2, 1) = myWb.ActiveSheet.Range("d4").Value
xlo.Worksheets(1).Cells(2, 2) = myWb.ActiveSheet.TextBox1.Text
xlw.Save
xlw.Close
Set xlo = Nothing
Set xlw = Nothing
End Sub
If you prefer, you could also use myWb.Activate to put back your main Workbook as active. It will also work if you do it with a Worksheet object. Using one or another mostly depends on what you want to do (if there are multiple sheets, etc.).
I think the reason that this is happening could be because TextBox1 is scoping to the VBA module and its associated sheet, while Range is scoping to the "Active Sheet".
EDIT
It looks like you may be able to use the GetObject function to pull the textbox from the workbook.
The issue is with this line
xlo.Worksheets(1).Cells(2, 2) = TextBox1.Text
You have the textbox defined at some other location which you are not using here. Excel is unable to find the textbox object in the current sheet while this textbox was defined in xlw.
Hence replace this with
xlo.Worksheets(1).Cells(2, 2) = worksheets("xlw").TextBox1.Text
I have 54 excel files with three sheets each, each sheet has a different amount of data entries but they are set out in a identical format, and I need to import the data from those sheets into a single workbook using VBA.
Is there any way I can program it so I can build the loops to import the data, but without having to write in each workbook name for each loop/sheet? I think I can use the call function, but I don't know how to make the loop codes independent of the workbook name they apply to.
Thank you so much in advance,
Millie
Sure just loop over the workbooks in a folder open them and then loop over their sheets. Depending on slight differences in format you might need to do some extra work when importing.
Sub ImportWorkbooks(destination as workbook, importFolderPath As String)
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object associated with the directory
Set objFolder = objFSO.GetFolder(importFolderPath)
'Loop through the Files collection and import each workbook
For Each objFile In objFolder.Files
Dim source As Workbook
Set source = Application.Workbooks.Open(objFile.Path, ReadOnly:=True)
ImportWorkbook source, destination
wb.Close
Set wb = Nothing
Next
Set objFolder = Nothing
Set objFile = Nothing
Set objFSO = Nothing
End Sub
Sub ImportWorkbook(source As Workbook, destination as Workbook)
Dim sheet As Worksheet
'Import each worksheet
For Each sheet In source.Sheets
ImportWorksheet sheet, destination
Next sheet
End Sub
Sub ImportWorksheet(sheet As Worksheet, destination as Workbook)
'Perform your import logic for each sheet here (i.e. Copy from sheet and paste into a
'sheet into the provided workbook)
End Sub
Basic usage would be something like the following to import into the current workbook:
ImportWorkbooks ThisWorkbook, "c:\path\to\folder\containing\workbooks\to\import"
It only takes two things:
An array with the workbook file names in it, e.g.
dim books
books = array("book1.xls","book2.xls",....)
Then your loop code looks something like
dim myBk as Workbook
dim bkFile as string
For Each bkFile in books
myBk = Workbooks.Open(bkFile, ReadOnly)
myBk.Activate
'Transfer cells from myBk to target workbook
target.cells(--).Value = myBk.Sheets("myStuff").Cells(--)
...
Next
I can't help you with the detail. You'll need to change the target.cells argument for each pass through the loop to shift the data destination.