Create excel workbooks from access rows - excel

Here is what I am trying to do. I am trying to create a workbook based on a template named by the title and to create a workbook for each row. And for the macro to loop until all rows have been depleted.
The deliverables that I want at the end are 3 excel documents named (Alpha.xlsx, Beta.xlsx, Gamma.xlsx) with the corresponding values from access plugged into their corresponding cells in their corresponding workbook. The subsequent math is there because I need to be able to manipulate the values once they are in excel.
Here is some of the research that I've found that I haven't quite been able to make much sense of due to my lack of experience coding in vba.
Links
(I can't post more than 2 so I'll keep the number of articles terse):
Research: databasejournal.com/features/msaccess/article.php/3563671/Export-Data-To-Excel.htm
Example Database/Spreadsheet:
http://www.sendspace.com/file/iy62c0
Image Album (has a picture of the database and the template in case you don't want to download):
http://imgur.com/pytPK,PY8FP#0
Any help will be much appreciated! I've been reading up and trying to figure out how to get this to work #.#

This isn't complete, but should help you get started...
Option Compare Database
Option Explicit
'Enter Location of your Template Here
Const ExcelTemplate = "C:\MyTemplate.xltx"
'Enter the Folder Directory to save results to
Const SaveResutsFldr = "C:\Results\"
Sub CreateWorkbook()
Dim SaveAsStr As String
Dim ExcelApp, WB As Object
'Create Reference to Run Excel
Set ExcelApp = CreateObject("Excel.Application")
'Create Reference to your Table
Dim T As Recordset
Set T = CurrentDb.OpenRecordset("tblData")
'Loop through all Record on Table
While Not T.BOF And T.EOF
'Open Your Excel Template
Set WB = ExcelApp.Workbooks.Open(ExcelTemplate)
'Enter your data from your table here to the required cells
WB.Worksheets("NameOfYourWorkSheet").Range("A1") = T("numValue1")
'Repeat this line for each piece of data you need entered
'Changing the Sheet name, cell range, a field name as per your requirements
'WB.Wor...
'WB.Wor...
'Save and Close the Workbook
SaveAsStr = SaveResutsFldr & T("Title") & ".xlsx"
WB.SaveAs SaveAsStr
WB.Close
Set WB = Nothing
'Move to the Next Record
T.MoveNext
Wend
'Close down the Excel Application
ExcelApp.Quit
Set ExcelApp = Nothing
End Sub

Related

Application.Workbooks(V_WBNameOutPut).Activate alternative

I use this piece of code:
Application.Workbooks(V_WBNameOutPut).Activate
to activate a particular excel file, I notice that this method goes in error if the "File name extension" (in the View tab of the Folder Menu) is flagged.
In order to be independent of this, what modification should I do/include to the code or what alternative method should I use?
This answer is based on the comment
I interchange many times during the macro run between 2 workbooks, input and output
excel files, and I need to activate the V_WBNameOutPut, to paste and elaborate, and > this is done multiple times during the run. From the input file, I create the > V_WBNameOutPut file.
As #brax said - capture the workbook when it's opened and you don't have to worry about the extension after that.
Sub Test()
'Open the first workbook and store reference to it.
Dim wrkBk1 As Workbook
Set wrkBk1 = Workbooks.Open("H:\Darren Bartrup-Cook\Test 1.xlsx")
'Open the second workbook and store reference to it.
Dim wrkBk2 As Workbook
Set wrkBk2 = Workbooks.Open("H:\Darren Bartrup-Cook\Test 2.xlsx")
'Copy/paste from wrkbk1 to wrkbk2.
wrkBk1.Worksheets("Sheet1").Range("A1").Copy Destination:=wrkBk2.Worksheets("Sheet1").Range("A4")
'Create a new sheet in wrkbk2.
Dim NewWrkSht As Worksheet
Set NewWrkSht = wrkBk2.Worksheets.Add
NewWrkSht.Name = "My New Sheet"
'Paste copy/paste values from wrkbk1 to wrkbk2.
wrkBk1.Worksheets("Sheet1").Range("A2").Copy
NewWrkSht.Range("A5").PasteSpecial Paste:=xlPasteValues
'Make A3 in wrkbk2 equal the value in wrkbk1 A3.
wrkBk2.Worksheets("Sheet1").Range("A3") = wrkBk1.Worksheets("Sheet1").Range("A3")
'Close the two workbooks.
wrkBk2.Close SaveChanges:=True
wrkBk1.Close SaveChanges:=False
End Sub

How to get dependent drop-down lists to work in exported workbook?

I'm still reasonably new to VBA and feel I'm punching a little above my weight, so hopefully someone can help.
I need to issue a spreadsheet to people in my company which they can fill out and send it back. This needs to be done multiple times, so I have tried to automate this as much as possible. The source data is pasted in an "input" tab - this is then pivoted by user and input into a template tab. I can select any user and run a macro which does this and exports the filled out template to a new workbook.
In this template tab, I have dependent drop-down lists, which I have done by data validation - this relies on named ranges from the "coding" tab, which is also exported. One named range shows a list of values, and the other indexes over this and matches it to the required cell, to ensure only valid combinations are shown.
My issue is that the new workbook must not contain any links to the master - it should function completely in its own right. However, something is going wrong with the data validation/named ranges. Either some named ranges are being deleted (I know which bit of code is doing that but without it you get prompted to update links) or the data validation formula links back to the original workbook and doesn't work. I cannot find another way of achieving what I need without this particular data validation set up, so I need to try and adjust my macro to cater for this.
Is it possible to simply copy the template and coding tabs, with all the data validation, to a new workbook and break all links to the original, so that there are no startup prompts and the drop-downs all work?
Sub Copy_To_New_Workbook()
Dim wb As Workbook
Dim name As String
Dim ExternalLinks As Variant
Dim x As Long
Dim strFolder As String, strTempfile As String
name = Worksheets("Control").Cells(14, 7).Value
Let FileNameIs = Range("Filepath").Value & Range("FileName").Value
Set wb = Workbooks.Add
ThisWorkbook.Worksheets("Coding").Copy Before:=wb.Sheets(1)
ActiveSheet.name = "Coding"
ThisWorkbook.Worksheets("Transactions").Copy Before:=Worksheets("Coding")
ActiveSheet.name = "Transactions"
With ActiveSheet.UsedRange
.Value = .Value
End With
Application.DisplayAlerts = False
Worksheets("Sheet1").Delete
Application.DisplayAlerts = True
ExternalLinks = wb.LinkSources(Type:=xlLinkTypeExcelLinks)
ExternalLinks = wb.LinkSources(Type:=xlLinkTypeExcelLinks)
For x = 1 To UBound(ExternalLinks)
wb.BreakLink name:=ExternalLinks(x), Type:=xlLinkTypeExcelLinks
Next x
Dim objDefinedName As Object
For Each objDefinedName In wb.Names
If InStr(objDefinedName.RefersTo, "[") > 0 Then
objDefinedName.Delete
End If
Next objDefinedName
On Error GoTo 0
wb.SaveAs Filename:=FileNameIs, FileFormat:=52
ActiveWorkbook.Close
End Sub

Using VBScript to Change Excel View to Page Layout

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

Save single excel worksheet as new excel file with new input

I'm working with vba and access 2010. I have here an excel file as a template, with 3 different worksheets and I would like to write stuff in these different worksheets depends on what is in my access db. I just have one trouble: the original excel template file should not be changed. I would like to save always in a new file with my input and this time only with 1 worksheet (depends whats in the access db).
So this is my code in access:
Dim excelObject As Object
Dim sheet As Object
Dim myRec As DAO.Recordset
Dim fldCustName As DAO.Field
'open excel file
Set objExcel = CreateObject("Excel.Application")
Set excelObject = objExcel.Workbooks.Open("MyTemplate.xlsx")
Set sheet = excelObject.Worksheets(1)
'read table
Set myRec = CurrentDb.OpenRecordset("MyTable")
Set fldCustName = myRec.Fields("ID")
'select worksheet and add text to excel depends on table
If fldCustName = 1000 Then
sheet.Cells(1, "A") = "Loop..."
End If
If fldCustName = 2000 Then
sheet.Cells(1, "A") = "Loop..."
End If
'and so on...
'save and close
excelObject.Save 'problem: writes always in the same file and only worksheet 1
excelObject.Close
objExcel.Quit
As I said, the problem is that I save the changes always in my template.xlsx and I'm also ignoring the other worksheets. What is the easiest way to solve this? Maybe:
reading the table -> decide which worksheet I need -> save this worksheet as .xlsx -> start writing
But how? Any ideas? Thank you
The code below saves your workbook in a new location with only one worksheet containing your output.
Excel.Application.DisplayAlerts=False 'suppresses dialog boxes when deleting worksheets
Dim wsName As String
'replace this code with a function that gives you the name of the worksheet
wsName = "1"
'add your code to query the data and write to worksheet here
For Each Sh In excelObject.Worksheets
If Sh.Name <> wsName Then
Sh.Delete
End If
Next Sh
ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & wsName & "output.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
Excel.Application.DisplayAlerts=True
excelObject.Close

Creating graph in Excel using VBA/macro

I created a macro in Excel for creating bar graphs automatically.
Whenever I run it, it gives "smr run time error" and I am not able to figure out what is wrong with my code.
Sub CreateGraph()
'
' CreateGraph Macro
''Initialize variables
Dim lastRow As Integer
Dim xlsPath As String
Dim xlsFile As String
xlsPath = "H:\"
xlsFile = "text.xls"
Workbooks.Open Filename:=xlsPath & xlsFile
ActiveWindow.SmallScroll Down:=-81
Range("A1:B" & lastRow).Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.SetSourceData Source:=Range("'TEST'!$A$1:$B" & lastRow)
ActiveChart.ChartType = xlBarClustered
ActiveChart.Axes(xlCategory).Select
ActiveSheet.ChartObjects("Chart 2").Activate
ActiveChart.Axes(xlCategory).ReversePlotOrder = True
Range("Q111").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub
Can anyone help me in solving this puzzle please.
Also for running any macro automatically from SAS, I always have to change the Excel options for "enable all macros" which I suppose is not good. I have seen people creating and running macros without doing this. Can you please tell me how can I run the macros with enabling all macros option in Excel.
The code within this version of the answer is essentially unchanged from the previous version. However, the text has been rewritten to (1) describe my experience of this type of project, (2) answer the true question and (3) better explain the solution.
My experience of this type of project
I have been involved in five such projects. In each case, the client believed they required the automatic creation of charts but detailed discussion revealed that that this was not the requirement. The clients all published a substantial number of charts per month but most of the charts were the same as last month but with new data. They needed to automate the provision of new data for the charts. Every month some charts were revised but this was humans agreeing better ways of presenting the data. They wanted the 90% of charts that were unchanged to go through without any effort and implementation of the revisions to be as easy as possible.
In this case, the questioner publishes 100 charts per month in the form of an Excel workbook. The data for these charts comes from an Access database. The solution allows for the charts to be changed easily but this is to ease the programming and not to provide more than has been requested.
Release Template.xls
The solution requires a hand-crafted workbook named Release Template.xls. This workbook will contain all the charts and the Month 1 data. The solution creates a copy of this workbook named Release YYMM.xls in which the Month 1 data has been overwritten by the MM/YY data.
Release Template.xls contains a worksheet, Params, which will be deleted from the release version. This worksheet has a title row and one data row per chart. There are five columns: Sheet Name, Range, Number of Rows, Number of Columns and SQL command.
Sheet Name and Range define the location of the source data for the chart.
Number of Rows and Number of Columns define the size of the range. These values should be generated from the range (or vice versa) but this generation is not difficult and its inclusion would complicate the answer for little advantage.
SQL command is the command to be used to extract the data for the chart from the database. The code below assumes the SQL command generates a Recordset containing data ready to drop into the worksheet.
These parameters could be in the Access database but I believe they fit more logically in the workbook. These parameters control getting data out of the Access database and into the Excel workbook. If a chart is changed such that it requires new data, these parameters must be changed to match but no change is required to the code.
Envelope
When this code was tested, it was within an Access Module. It could probably be transferred to a form but that has not been tested. There MUST be a reference to the "Microsoft Excel 11.0 Object Library".
This envelope should be suitable for any similar problem.
Option Compare Database
Option Explicit
Sub Control()
' This list includes the variables for the envelope and the generation code
Dim DestFileName As String
Dim Path As String
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
' I have my Excel file and my Access database in the same folder.
' This statement gets me the name of the folder holding my database.
' You may need to define a different path.
Path = Application.CurrentProject.Path
' Create path and file name of "Resource YYMM.xls"
DestFileName = Path & "\" & "Resource " & Format(Date, "yymm") & ".xls"
' Create copy of "Resource Template.xls".
FileCopy Path & "\Resource Template.xls", DestFileName
Set xlApp = New Excel.Application
With xlApp
.Visible = True ' This slows the macro but helps with debugging
' .Visible = False
Set xlWB = .Workbooks.Open(DestFileName)
With xlWB
' Code to amend "Resource YYMM.xls" goes here
.Save ' Save the amended workbook
.Close ' Close the amended workbook
End With
Set xlWB = Nothing ' Clear reference to workbook
.Quit ' Quit Excel
End With Set xlApp = Nothing ' Clear reference to Excel
End Sub
Code to generate copy data to workbook
This code assumes it is possible to create SQL statments that will generate Recordsets of data ready to drop into the workbook.
This code has been partially tested. The tests parameters defined ranges in the workbook which matches the size of the parameters. The data loaded into Params() was written to these ranges.
Dim DestSheetName As String
Dim NumCols As Integer
Dim NumRows As Integer
Dim OutData() as Variant
Dim Params() as Variant
Dim RngDest As String
Dim RowParamCrnt As Integer
Dim RowParamMax As Integer
Dim SQLCommand As String
With .Sheets("Params")
' Find last used row in worksheet
RowParamMax = .Cells(Rows.Count,"A").End(xlUp).Row
' Read entire worksheet into array Params
Params = .Range(.Cells(1, 1), .Cells(RowParamMax, 5)).Value
xlApp.DisplayAlerts = False ' Surpress delete confirmation
.Delete ' Delete parameters sheet
xlApp.DisplayAlerts = True
End With
' Params is an array with two dimensions. Dimension 1 is the row.
' Dimension 2 is the column. Loading Params from the range is
' equivalent to:
' ReDim Params( 1 to RowParamMax, 1 to 5)
' Copy data from worksheet to array
For RowParamCrnt = 2 To RowParamMax
DestSheetName = Params(RowParamCrnt, 1)
DestRng = Params(RowParamCrnt, 2)
NumRows = Params(RowParamCrnt, 3)
NumCols = Params(RowParamCrnt, 4)
SQLCommand = Params(RowParamCrnt, 5)
' Use the SQL command to create a Recordset containing the data
' for the chart.
' Check the Recordset's dimensions against NumRows and NumCols
ReDim OutData(1 to NumRows, 1 to NumCols)
' Note (repeat Note): the first dimension is for rows and the
' second dimension is for columns. This is required for arrays
' to be read from or to a worksheet.
' Move the data out of the Recordset into array OutData.
.Sheets(DestSheetName).Range(DestRng).Value = OutData
Next

Resources