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
Related
I need to copy a couple of excel sheets ("Y", "X") from one file to the same sheet in another excel file (call it Z - the same file that I'm using the VBA on).
my limitation is that the name and path of the first excel file (with the X,Y) are changing, therefore I'm trying to write something more generic using the "as String" and the Application.GetOpenFilename() command but I'm receiving an error.
Tried to separate into 2 different subs
Sub BrowseForFile()
Dim sFileName As String
sFileName = Application.GetOpenFilename(, , "open the file: " )
If sFileName = "false" Then Exit Sub
MsgBox sFileName
Workbooks.Open (sFileName)
Workbooks(sFileName).Sheets("X").Activate
Stop
Runtime Error 9
file doesn't find (1004 I think)
If the user presses the Cancel button then the GetOpenFilename function returns a boolean False not a string "false" so you need to test for If sFileName = False Then and declare it as Variant.
If you open a workbook always reference it to a variable so you can use that to access the workbook easily
Dim OpenedWb As Workbook
Set OpenedWb = Workbooks.Open(sFileName)
Then you can use the variable Wb to reference the workbook you opened
OpenedWb.Worksheets("X").Activate
Note that using .Select and .Activate is a bad practice and should be avoided (How to avoid using Select in Excel VBA). Instead use another reference to reference your workbook.
Dim ws As Worksheet
Set ws = OpenedWb.Worksheets("X")
And access a range like ws.Range("A1").Value for example.
Sub BrowseForFile()
Dim sFileName As Variant 'needs to be variant because cancel returns a boolean False
sFileName = Application.GetOpenFilename(, , "open the file: " )
If sFileName = False Then Exit Sub
MsgBox sFileName
Dim OpenedWb As Workbook
Set OpenedWb = Workbooks.Open(sFileName)
Dim ws As Worksheet
Set ws = OpenedWb.Worksheets("X")
MsgBox ws.Range("A1").Value 'output the value of `A1` in worksheet `X` of workbook `sFileName`
End Sub
I have a few hundred or so excel files in a directory each with a unique identifier somewhere in the name, 103, 208c, 231a, etc. Identifiers are housed in a column in the workbook with the code. Based on these identifiers I'm trying to dynamically open the workbook containing the string of text and paste a single cell to be next to it's workbooks identifier.
I tried to get it to work for a single case below but after the would be dynamic file opens the macro ends rather than selecting the value and pasting it. If anyone has any suggestions on how to fix that or how to switch this code from single case to dynamic/loop based I'd greatly appreciate it. I'm relatively new to coding VBA. Normally only need to rarely read it/step thru existing code.
Option Explicit
Sub Process()
On Error Resume Next
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
Dim sFound As String, fPath As String
Dim BaseFile As Workbook
Dim TestSheet As Worksheet
Dim WB1 As Workbook
Set TestSheet = ThisWorkbook.Sheets("TestSheet")
Set BaseFile = ThisWorkbook
fPath = "\\WhateverDirectory\"
sFound = Dir(fPath & "*231a*") '231a should be values in column B row 4 on in the TestSheet
If sFound <> "" Then
Set WB1 = Workbooks.Open(fPath & sFound)
WB1.Sheets("RCM").Range("D6").Copy
BaseFile.Activate
TestSheet.Range("C4").PasteSpecial xlPasteValues
End If
I want to copy a range of cells in my .csv file into a template.csv (named "pp"). Then I would like to save the template as "name of the original .csv file_2", without closing the original template as I would need it to do this procedure in loop for all the files in my folder. I have come up with this code that doesn't work:
Sub LoopThroughDirectory()
Dim MyFile As String
Dim pp As Workbook ' Workbook to receive the copied data
Dim ppSht As Worksheet ' Worksheet where copied data will be inserted
Dim Wkb As Workbook ' Temporary workbook for the Loop
Dim Sht As Worksheet ' Temporary worksheet variable for the loop
MyFile = Dir("R:\COMT study\Silvia\Cognitive data\COMT 1\Tasks\CPT*.csv*")
Set pp = Workbooks("pp.csv")
Set ppSht = pp.Sheets("Sheet1")
Do While MyFile <> ""
Set Wkb = Workbook.Open("R:\COMT study\Silvia\Cognitive data\COMT 1\Tasks\CPT" & MyFile)
Set Sht = Wkb.Worksheets("sheet1")
Sht.Range("A1:G113").Copy
With ppSht
.Range("A1:G113").PasteSpecial xlPasteFormulas
End With
pp.SaveCopyAs Filename = MyFile_2.csv
Wkb.Close True
MyFile = Dir
Loop
End Sub
I am new to the vba coding and I am not sure what I am doing wrong as I don't get any error messages, the code simply doesn't run. Do you have any suggestion?
First of all I would like to recommend you how to use a CSV file (Comma-separated values). By this a csv file does not have any sheets. Therefore you can reach the worksheet with the following, there wb is the workbook. Another good advice is to use Option Explicit that enables some error codes, example if you get to initialize a variable.
Dim pp As Workbook
pp.Worksheets (1)
Do While MyFile <> ""
Set wb = Workbooks.Open("R:\COMT study\Silvia\Cognitive data\COMT 1\Tasks\CPT" & MyFile)
With wb.Worksheets(1)
Range(A1,G113).copy
End With
With ppSht
.Range(A1,G113).PasteSpecial xlPasteFormulas
End With
pp.SaveCopyAs Filename = "MyFile_2.csv"
'Remove the wb.Close if you want the sheet to stay open (Not recommended if there are many files)
wb.Close
MyFile = Dir
loop
Try using some of this (Haven't tried it so just use it as a template). See if you can get any errors or at least if you can collect the data from the file into a array.
I have a workbook containing one worksheet ("DB Output" or Sheet 34) which I would like to copy to several (around 45) files in within the same folder.
None of the target files have an existing sheet named "DB Output" - the objective is to find a way to insert a copy of this sheet, forumlas and all, into each one.
The range of cells on that sheet that needs to be copied to a sheet of the same name in each book is A1:PE5
The sheet contains references to cells in the book it is currently in, however as the files which I am seeking to copy the worksheet to all share the same template, I want the references to be to the local file, not the original one.
I've tried looking at RDBMerge, however it seems that is for merging sheets, and while I do want to do that, it will not help me do it multiple times quickly.
Likewise I have looked on SO for similar situations, this is the closest, however my attempts to adapt that code have failed as I only have a single workskeet. Never the less, as it is always useful to inlcude what you have already tried, here is my existing attempt:
Option Explicit
Public Sub splitsheets()
Dim srcwb As Workbook, trgwb As Workbook
Dim ws As Worksheet, t1ws As Worksheet
Dim rng1 As Range
Dim trgnm As String
Dim fpath As String
Application.ScreenUpdating = False
'--> Set this to the location of the target workbooks
fpath = "C:/file/path/"
Set srcwb = ThisWorkbook
For Each ws In srcwb.Worksheets
trgnm = ws.Name
'--> Change A1:B3 to the range to be copied to inside page
Set rng1 = srcwb.Sheets(trgnm).Range("A1:PE5")
Set trgwb = Workbooks.Open(fpath & trgnm & ".xlsm")
With trgwb
Set t1ws = .Sheets("DB Output")
End With
'--> Change A1:B3 to the range where you want to paste
rng1.Copy t1ws.Range("A1:PE5")
trgwb.Close True
Next
Application.ScreenUpdating = True
End Sub
However this starts with the first sheet in the workbook that contains DB Output (the sheet to be copied) and gives an error that "NameOfSheet1.xlsm" does not exist in that directory (which it does not).
Any help is much appreciated.
This should copy from the active workbook to all files in a directory. If you need help modifying it to fit your specific use let me know!
Edit: fixed code to only copy A1:PE5 and save each workbook.
Sub Example()
Dim path As String
Dim file As String
Dim wkbk As Workbook
path = "C:\Test\"
file = Dir(path)
Application.DisplayAlerts = False
Do While Not file = ""
Workbooks.Open (path & file)
Set wkbk = ActiveWorkbook
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "DB Output"
ThisWorkbook.Sheets("DB Output").Range("A1:PE5").Copy Destination:=wkbk.Sheets("DB Output").Range("A1")
wkbk.Save
wkbk.Close
file = Dir
Loop
Application.DisplayAlerts = True
End Sub
Please note that I did not add error handling so this could break if the active workbook is included in the directory you are trying to copy or if a sheet with the same name already exists in the workbook. If this is an issue let me know and I will add error handling.
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