I have a couple tables that are connected to an access database through Microsoft Query. If I move the location of the access file or I need a way to update the source location especially since I will need to share this file with other people.
All the connections are ODBC and are from the same access file.
Since all the connection are uniform I looped through each one and replaced the current source file with the file selected through the windows file explorer.
Sub SwitchODBCSource()
Dim conn As WorkbookConnection
Dim sOldConnection As String, sNewConnection As String
getfilePath = Application.GetOpenFilename()
FileType = ".accdb"
If InStr(getfilePath, FileType) Then
fileName = Dir(getfilePath)
filePath = Replace(getfilePath, "\" & fileName, "")
For Each conn In ActiveWorkbook.Connections
With conn
conn.ODBCConnection.BackgroundQuery = False
conn.ODBCConnection.CommandType = xlCmdSql
conn.ODBCConnection.Connection = Array(Array( _
"ODBC;DSN=MS Access Database;DBQ=" & filePath & "\" & fileName & ";DefaultDir=" _
), Array( _
filePath & ";DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;" _
))
End With
Next conn
ActiveWorkbook.RefreshAll
Call Sheet1.dropDown
Set conn = Nothing
Else
MsgBox ("Can only use " & FileType & " files")
End If
End Sub
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 have a MS Acccess 2013 Database with many stored queries and linked tables to Excel spreadsheets. There are 3 in particular I need to export and I need to create backups as well. In my attempt to automate it, I am trying to use VBA.
Query Names:
query1
query2
query3
The DB is located in \\Reports\Run\Data
I would like BOTH the first and second query to export to both \\Reports\Type1\ and \\Reports\Type1\[new sub-folder 1]
I would like the third query to export to both \\Reports\Type2\and \\Reports\Type2\[new sub-folder 2]
One of the linked Excel spreadsheets (Table Name = Sheet1) has 1 single field and 1 single entry, which is the ReportDate. I would like both [new sub-folder 1] and [new sub-folder 2] to be that single date entry. For example, if 2019-03-06 was the entry, both sub-folders should be called "2019-03-06". These are my backup and stored copies.
The export should overwrite the existing files in \\Reports\Type1 and \\Reports\Type2.
It would be nice to be able to prefix the names the files in the new sub-folders with the ReportDate as well if possible.
So the final result would then be
\\Reports\Type1\2019-03-06\20190306_query1.xlsx,
\\Reports\Type1\2019-03-06\20190306_query2.xlsx and
\\Reports\Type2\2019-03-06\20190306_query3.xlsx as an example.
I created a macro to export and converted it to VBA as a starting point. However, I am not sure how to do the dynamic naming and changing the path dynamically of the export.
Here is the code I used. I hope it helps someone else!
Option Compare Database
Option Explicit
Public Function ExportExcel()
'Declare all variables
Dim file As Object
Dim filepath As String
Dim fp_report1 As String
Dim fp_report2 As String
Dim fp_report1_date As String
Dim fp_report2_date As String
Dim data1 As String
Dim data2 As String
Dim data3 As String
Dim fp_report1_data1 As String
Dim fp_report1_data2 As String
Dim fp_report2_data3 As String
Dim fp_reportdate As String
Dim reportdate_backup As String
Dim reportdate As String
Dim data1_run As String
Dim data2_run As String
Dim data3_run As String
Dim myVar As Date
'Get report date from the ReportDate linked table
myVar = DLookup("ReportDate", "tbl_reportdate", "ReportDate")
' Get current path
filepath = CurrentProject.Path
'Destination for files for dashboard
fp_report1 = Left(filepath, 87) & "\report1\"
fp_report2 = Left(filepath, 87) & "\report2\"
'Location for backup with the date as the folder name
fp_report1_date = Left(filepath, 87) & "\report1\" & Format(myVar, "yyyy-mm-dd")
fp_report2_date = Left(filepath, 87) & "\report2\" & Format(myVar, "yyyy-mm-dd")
'Location of raw reports to backup and date file
fp_report1_data1 = Left(filepath, 97) & "report1_data1.xls"
fp_report1_data2 = Left(filepath, 97) & "report1_data2.xls"
fp_report2_data3 = Left(filepath, 97) & "report2_data3.xls"
fp_reportdate = Left(filepath, 97) & "ReportDate.xlsx"
'If the folders for the backup doesn't exist, create it, otherwise, do nothing.
If Dir(fp_report1_date, vbDirectory) = "" _
Then MkDir (fp_report1_date) _
Else _
If Dir(fp_report2_date, vbDirectory) = "" _
Then MkDir (fp_report2_date) _
Else _
'Exact path with file name for backup of processed data in the appropriate date folder
data1 = fp_report1_date & "\" & "data1.xlsx"
data2 = fp_report1_date & "\" & "data2.xlsx"
data3 = fp_report2_date & "\" & "data3.xlsx"
reportdate_backup = fp_report1_date & "\" & "ReportDate.xlsx"
'Exact path with file name for dashboard to automatically pull
data1_run = fp_report1 & "data1.xlsx"
data2_run = fp_report1 & "data2.xlsx"
data3_run = fp_report2 & "data3.xlsx"
reportdate = fp_report1 & "ReportDate.xlsx"
'Export queries into the date backup folder
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "data1", data1
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "data2", data2
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "data3", data3
'Copy the files from the date backup folder into the path to be used by the dashboard. This includes the raw data in the reports and all the processed reports
FileCopy data1, data1_run
FileCopy data2, data2_run
FileCopy data3, data3_run
FileCopy fp_report1_data1, fp_report1_date & "\" & "report1_data1.xls"
FileCopy fp_report1_data2, fp_report1_date & "\" & "report1_data2.xls"
FileCopy fp_report2_data3, fp_report2_date & "\" & "report2_data3.xls"
FileCopy fp_reportdate, reportdate_backup
FileCopy reportdate_backup, reportdate
End Function
I have a CSV export from an LDAP DB and I have to read data with a Classic ASP page.
The format of the CSV file is like
CRDLVR47E67L781V#1653#CORDIOLI#ELVIRA#658#elvira.cordioli#sender.at#SI
I can read the file line by line, and have to split the line manually.
If I change the # value to a comma I can access the file by column. Can I make the asp page able to access the file by column, in order to obtain the single value keeping the # separator?
My connection string is
Set oConn = Server.CreateObject("ADODB.connection")
oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=http://export/caselle.csv;Extended Properties='text;HDR=Yes;FMT=Delimited'"
and I can read line from the CSV file with the query
Set RS=Server.CreateObject("ADODB.recordset")
RS.open "SELECT * FROM utenti_aospbo.csv", oConn
now I can only read rs.fields(0), that output the entire line, like
CRDLVR47E67L781V#1653#CORDIOLI#ELVIRA#658#elvira.cordioli#sender.at#SI
I'd like to have
response.write rs.fields(0) 'CRDLVR47E67L781V
response.write rs.fields(5) 'elvira.cordioli#sender.at
While I can't rule out that there is some version of OLEDB that does HTTP or accepts FMT and FORMAT in the connection string, I'm sure that the Data Source property of an ADODB Text connection needs to be a folder.
Instead of trying to specify a global separator in the connection string or the in the registry, I'd use a schema.ini file to describe the meta info in a file specific way.
All in one:
cscript 41224005.vbs
.\41224005.vbs
Option Explicit
Dim oFS : Set oFS = CreateObject("Scripting.FileSystemObject")
Dim sF
For Each sF In Split(".\41224005.vbs ..\data\schema.ini ..\data\data1.txt")
WScript.Echo sF
WScript.Echo oFS.OpenTextFile(sF).ReadAll()
WScript.Echo "---------------"
Next
Dim sDir : sDir = oFS.GetAbsolutePathName("..\data\")
Dim sCS : sCS = Join(Array( _
"Provider=Microsoft.Jet.OLEDB.4.0" _
, "Data Source=" & sDir _
, "Extended Properties='" & Join(Array( _
"text" _
), ";") & "'" _
), ";")
Dim oDb : Set oDb = CreateObject("ADODB.Connection")
oDb.Open sCS
'WScript.Echo oDb.ConnectionString
Dim oRS : Set oRS = oDb.Execute("SELECT * FROM [data1.txt]")
WScript.Echo oRS.Fields(0).Value
WScript.Echo oRS.Fields(6).Value
oRS.Close
oDb.Close
---------------
..\data\schema.ini
[data1.txt]
FORMAT=Delimited(#)
ColNameHeader=False
---------------
..\data\data1.txt
CRDLVR47E67L781V#1653#CORDIOLI#ELVIRA#658#elvira.cordioli#sender.at#SI
---------------
CRDLVR47E67L781V
SI
I am attempting to import data into my MS Access project via TransferText, but am receiving error #3051: "The Microsoft Access database engine cannot open or write to the file ''. It is already opened exclusively by another user, or you need permissions to view and write its data."
It is odd to me that the filename given in the error message is blank. I have checked and rechecked the file name, even to perform a check "If Not fso.FileExists(file_name) Then ... End If" prior to the TransferText call.
I have also checked and rechecked the table name and the file permissions. The table is successfully emptied before the TransferText call, so I know that works. The file is in a subfolder relative to the Access database file in a folder on my desktop. I have not set or unset any permissions for any of the folders or files.
Until now I had been using DoCmd.TransferSpreadsheet to import the data that is downloaded from a web based tool, but I found Excel was misinterpreting some alphanumeric codes as numbers in scientific format, such as 1E100 would become 1E+100 in the Excel file, so the data was corrupted before getting to the Access database. These codes are getting corrupted in uncorrectable ways, so I can't modify the data after import. I found I could save the data from the web tool as a CSV file rather than an Excel file; this led me to try to use DoCmd.TransferText.
Below is the code I am using:
Private Function ImportExcel( _
ByVal file_name As String, _
ByVal table_name As String _
) As Integer
On Error GoTo Error
Dim fso As FileSystemObject, folder_name As String
Dim xl_book As Excel.Workbook
Dim xl_sheet As Excel.Worksheet
Dim i As Integer
' suppress excel's file-not-found popup
Set fso = New FileSystemObject
If Not fso.FileExists(file_name) Then
ImportExcel = -1
GoTo Finish
End If
' gets a workbook from a global application object
Set xl_book = Util.GetExcelWorkbook( _
file_name:=file_name, _
visible:=False, _
use_cache:=True _
)
If xl_book Is Nothing Then
ImportExcel = -1
GoTo Finish
End If
' always use the first worksheet
Set xl_sheet = xl_book.Sheets(1)
' fake the first record to force columns types
xl_sheet.range("A2").EntireRow.Insert
For i = 1 To xl_sheet.UsedRange.columns.count
xl_sheet.Cells(2, i) = "test"
Next i
' make sure the table is closed
DoCmd.Close _
ObjectType:=acTable, _
ObjectName:=table_name, _
Save:=acSaveNo
' link to file
DoCmd.SetWarnings False
If ".csv" = Right(file_name, 4) Then
' empty table
DoCmd.RunSQL "DELETE * FROM " & table_name, True
' import data
Debug.Print table_name
Debug.Print file_name
DoCmd.TransferText _
TransferType:=acImportDelim, _
SpecificationName:=table_name & " Import Spec", _
TableName:=table_name, _
FileName:=file_name, _
HasFieldNames:=True
Else
' delete table
On Error Resume Next
DoCmd.DeleteObject _
ObjectType:=acTable, _
ObjectName:=table_name
If 0 <> Err.Number Then
Resume Next
End If
On Error GoTo Error
' import data
DoCmd.TransferSpreadsheet _
TransferType:=acImport, _
TableName:=table_name, _
FileName:=file_name, _
HasFieldNames:=True, _
range:=xl_sheet.NAME() & "!" & _
xl_sheet.range( _
xl_sheet.Cells(1, 1), _
xl_sheet.Cells( _
xl_sheet.UsedRange.rows.count, _
xl_sheet.UsedRange.columns.count _
) _
).Address(RowAbsolute:=False, ColumnAbsolute:=False), _
SpreadsheetType:=acSpreadsheetTypeExcel9
End If
DoCmd.SetWarnings True
Finish:
Set xl_sheet = Nothing
If Not xl_book Is Nothing Then
xl_book.Close SaveChanges:=False
End If
Set xl_book = Nothing
Set fso = Nothing
Exit Function
Error:
Resume Finish
End Function
The two Debug.Print calls just prior to the DoCmd.TransferText call print exactly what is expected.
I have a piece of code, which imports a spreadsheet when the database is opened. Originally I had the path for the spreadsheet coded in, but the path is subject to change when the spreadsheet version is changed. The most up to date path is now stored in a global parameters table. I can't get the code to work with a variable, maybe I'm doing something stupid, I don't know, I'm fairly new to VB/VBA.
Function Import_Menu()
Dim db As DAO.Database
Set db = CurrentDb
Dim mpath As String
mpath = DLookup("MenuPath", "Global", "ID = 1")
On Error Resume Next: db.TableDefs.Delete "Activity_Menu": On Error GoTo 0
db.TableDefs.Refresh
DoCmd.TransferSpreadsheet _
TransferType:=acImport, _
SpreadsheetType:=acSpreadsheetTypeExcel9, _
TableName:="Activity_Menu", _
FileName:=" & mpath & ", _
HasFieldNames:=False, _
Range:="Task Menu!A3:AF120"
db.TableDefs.Refresh
db.Close: Set db = Nothing
End Function
This;
FileName:=" & mpath & ", _
results in the string & mpath & which is not correct.
If mpath is a full path and file name:
FileName:= mpath, _
If its just a path:
FileName:= mpath & "\BLA.BLOOP", _
(Ensuring you add a \ if needed)