I want to create some VBA code to open an existing Excel workbook, transfer the query to a new sheet and save the file with todays date and time. So far this is the code I
Private Sub cmd_planning_report_Click()
Dim ExportNumber As String
Dim ExportFileName As String
Dim ProjectPath As String
Dim FolderPath As String
Dim FilePath As String
Dim TemplatePath As String
ProjectPath = CurrentProject.Path
FolderPath = "Report_Templates"
FilePath = "Template.xlsx"
TemplatePath = ProjectPath & "\" & FolderPath & "\" & FilePath
ExportNumber = Format(Now(), "YYYYMMDD_HHMMss")
ExportFileName = "my_report_" & ExportNumber & ".xlsx"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "A1_Report", TemplatePath, True
End Sub
Which works as the query is exported to Template.xlsx but I would like it to save the file as ExportFileName
Looks like you just need this twist:
ProjectPath = CurrentProject.Path
FolderPath = "Report_Templates"
ExportNumber = Format(Now(), "YYYYMMDD_HHMMss")
ExportFileName = "my_report_" & ExportNumber & ".xlsx"
TemplatePath = ProjectPath & "\" & FolderPath & "\" & ExportFileName
You could rename the file once it is saved in the template with
NAME TemplatePath AS ExportFileName
Or make a copy of the file with the new name.
Dim fso As MyObject
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
fso.CopyFile TemplatePath, ExportFileName
Related
I am new in MS Access. I have pdf file location in textbox. I want when access report load then specific pdf file preview in that report (pdf read from file location). How can I achieve it? Please help?
You can display PDF in Report by converting its pages to images and display them. Withwsh.Runyou can extract duringReport_Loadevent, then store the pages paths in a temporary table.
Have Irfanview with PDF-Plugin installed.
In Front-End, create a table namedTmpExtractedPageswith oneShort-Textfield namedPathto store the paths of the extracted pages.
Create a report with Record-Source.
SELECT TmpExtractedPages.Path FROM TmpExtractedPages;
Add a Picture-Control in Detail-Section (no Header/Footer-Section), that fits to the page and bind it toPath
Put the following code inReport_Loadevent
Private Sub Report_Load()
Dim TempPath As String
TempPath = CurrentProject.Path & "\TempPdf"
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(TempPath) Then
fso.DeleteFolder TempPath
End If
fso.CreateFolder TempPath
Dim PdfFile As String
PdfFile = Me.OpenArgs
Const PathToIrfanView As String = "C:\Program Files (x86)\IrfanView\i_view32.exe"
Dim CmdArgs As String
CmdArgs = Chr(34) & PdfFile & Chr(34) & " /extract=(" & Chr(34) & TempPath & Chr(34) & ",jpg) /cmdexit" 'see i_options.txt in IrfanView folder for command line options
Dim ShellCmd As String
ShellCmd = Chr(34) & PathToIrfanView & Chr(34) & " " & CmdArgs
Debug.Print ShellCmd
Dim wsh As Object
Set wsh = CreateObject("WScript.Shell")
Const WaitOnReturn As Boolean = True
Const WindowStyle As Long = 0
wsh.Run ShellCmd, WindowStyle, WaitOnReturn
With CurrentDb
.Execute "Delete * From TmpExtractedPages", dbFailOnError
Dim f As Object
For Each f In fso.GetFolder(TempPath).Files
.Execute "Insert Into TmpExtractedPages (Path) Values ('" & Replace(f.Path, "'", "''") & "');", dbFailOnError
Next f
End With
Set fso = Nothing
Set wsh = Nothing
End Sub
You provide the path to the PDF to display asOpenArgsargument on open report:
DoCmd.OpenReport "rpt_pdf", acViewPreview, , , , "path\to\pdf"
Keep in mind that adding, then deleting records to the temp table, will bloat your database if you don't compact it later (or just deploy a fresh Front-End copy on start, as I do).
If you just need to display the pdf file, you could create a button next to the textbox and in its on click event:
Private Sub cmdView_Click()
If Nz(Me.txtPdfLocation) <> "" Then
Application.FollowHyperlink Me.txtPdfLocation
End If
End Sub
I am trying to import exported objects from another database. The file extension is vba. I have created a loop to go through all the objects. My loop does go through all the files properly. The loop does import a module as Module 1 for the first file. I want to rename the module from module 1 to the previous module name.
I am working with MS Access office 365.
Sub LoopThroughFiles2()
Dim strFile As String
Dim strNewFile As String
Dim strPath As String
Dim strNewPath As String
Dim strDBName As String
Dim strModName As String
strDBName = Application.CurrentProject.Name
strPath = ("C:\Users\Parents\Google Drive\Access Files\File7\")
strFile = Dir(strPath & "*")
Do While Len(strFile) > 0
Debug.Print strFile
Debug.Print strPath
strNewFile = Replace(strFile, ".vba", ".txt", 1, , vbTextCompare)
Debug.Print strNewFile
Name strPath & strFile As strPath & strNewFile
strNewPath = strPath & strFile
strModName = Replace(strNewFile, ".txt", "")
Debug.Print strModName
VBE.ActiveVBProject.VBComponents.Import strNewPath
VBProj.VBComponents("Module 1").Name = strModName 'error 424
DoCmd.Rename strModName, acModule, "Module1" 'error 7874
Loop
End Sub
You can't change the name directly, but you can change a property instead, like this:
VBE.ActiveVBProject.VBComponents("Module 1").Properties("Name").Value = strModName
I wrote a VBA code to print every row of my table into pdf files while creating directories for them.
At first it look great, it doesn't show any kind of error but when the loop ends (around 1200 rows) if I go check the files created, some worked perfectly while others are just blank pages.
Any idea why this might be happening?
Option Compare Database
Private Sub Command0_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim ps As DAO.Recordset
Dim MyFileName As String
Dim mypath As String
Dim temp As String
'mypath = "C:\Docs\"
Set db = CurrentDb()
Set rs = db.OpenRecordset("SELECT * FROM [TABLE]", dbOpenSnapshot)
Do While Not rs.EOF
On Error Resume Next
b = "C:\Docs\" & rs("ENTERPRISE")
MkDir (b)
b1 = "C:\Docs\" & rs("ENTERPRISE") & "\" & "ECONOMICS"
MkDir (b1)
b2 = "C:\Docs\" & rs("ENTERPRISE") & "\" & "ECONOMICS" & "\" & Year(rs("DATE")) & "-" & Month(rs("DATE"))
MkDir (b2)
a = b2 & "\" & rs("NUM") & "-" & rs("ITEM")
MkDir (a)
mypath = a & "\"
temp = rs("DOC_LANC")
MyFileName = rs("NUM") & rs("ITEM") & ".PDF"
DoCmd.OpenReport "PDF", acViewReport, , "[DOC_LANC]='" & temp & "'"
DoCmd.OutputTo acOutputReport, "", acFormatPDF, mypath & MyFileName
DoCmd.Close acReport, "PDF"
DoEvents
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
Set db = Nothing
End Sub
I'm currently exporting a table in Access 2013 to an Excel file using TransferSpreadsheet. I set the default filename and location. It's working fine, except that when the user changes the name they want to save the file as in the Save As dialog, the is not saved with that name. Is there a way I can get the file name the user entered in the Save As dialog and save the file with that name in the location they select?
Here's what I'm doing now:
Dim strTableName As String
Dim strBasePath As String
Dim strFullPath As String
Dim strFileName As String
Dim dlgSaveAs As Object
Const msoFileDialogSaveAs = 2
With CodeContextObject
strTableName = "New_Rules"
strBasePath = "C:\Users\" & Environ("USERNAME") & "\Documents\"
strFileName = "New_Account_Rules_" & Format(Date, "yyyy-mm-dd")
strFullPath = strBasePath & strFileName & ".xls"
' Display the Save As dialog with a default name and path
Set dlgSaveAs = Application.FileDialog(msoFileDialogSaveAs)
With dlgSaveAs
.InitialFileName = strFullPath
If dlgSaveAs.Show Then
' Do the export
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "New_Rules", strFullPath, True
End If
End With
Thanks in advance.
The SelectedItems() collection contains the list of filenames entered/selected. Since you're using the msoFileDialogSaveAs option, the FileDialog will permit only one selected item. So when .Show is True, just assign .SelectedItems(1) to your strFullPath variable:
With dlgSaveAs
' Set the initial/default filename...
.InitialFileName = strFullPath
If .Show Then
' Get the selected/entered filename...
strFullPath = .SelectedItems(1)
' Do the export...
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "New_Rules", strFullPath, True
End If
End With
I want to export a table (the table is called "Consultations") to Excel, and open the file. I'm doing this from a form with a button. At this point, I have the file exporting correctly, but Excel is not staying open. I tried using xlApp.Visible = True, but it is only opening Excel while the file is exported, then it closes Excel when it is done.
What code will I need to insert in order to keep Excel (and the exported file) open?
Private Sub btnExportConsultations_Click()
Dim curPath As String
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
curPath = CurrentProject.Path & "\Consultations - " & Format(Date, "MM") & "-" & Format(Date, "dd") & "-" & Format(Date, "yyyy") & ".xlsx"
DoCmd.TransferSpreadsheet acExport, 10, "Consultations", curPath, -1
End Sub
Create the spreadsheet and then use Application.FollowHyperlink to open it in the application associated with that file type --- which should be Excel.
Private Sub btnExportConsultations_Click()
Dim curPath As String
curPath = CurrentProject.Path & "\Consultations - " & _
Format(Date, "mm-dd-yyyy") & ".xlsx"
DoCmd.TransferSpreadsheet acExport, 10, "Consultations", curPath, -1
Application.FollowHyperlink curPath
End Sub
Note I also changed the curPath = line. You can get your formatted date into the file name with a single Format() expression instead of three.
Open the workbook in the Excel object you created with the Excel application object's Workbooks.Open method. Also, I would export the file before messing with Excel - not sure if it makes a difference but I think the code flows better at the very least.
Private Sub btnExportConsultations_Click()
Dim curPath As String
Dim xlApp As Object
curPath = CurrentProject.Path & "\Consultations - " & Format(Date,"mm-dd-yyyy")
DoCmd.TransferSpreadsheet acExport, 10, "Consultations", curPath, -1
Set xlApp = CreateObject("Excel.Application")
xlApp.Workbooks.Open(curPath)
xlApp.Visible = True
End Sub