The below code works great for refreshing an external link in vba however is there a way of changing the location of the link?
I can do this using linked table manager when ticking the 'Always prompt for new location', but I would like to do this via VBA, so that I could create a button for users to press to locate the new workbook
Select new workbook, Relink external excel workbook.
Function Relink()
Set db = CurrentDb
Set tdf = db.TableDefs("Sales")
tdf.Connect = "Excel 5.0;HDR=YES;IMEX=2;" & _
"DATABASE=C:\Sales.xlsb"
tdf.RefreshLink
End Function
I use this function to re-link my tables from a table, based on whether I am working on my c:\ drive or the network. I think you could modify this to have the user enter a file location, or use a file dialog to browse to a location.
Function relink_tables()
If Left(CurrentDb().Name, 2) = "C:" Then
source = "local"
Else: source = "network"
End If
Set RS = CurrentDb.OpenRecordset("select * from [linked table source] where source='" & source & "'")
source = RS.Fields("path")
For Each R In References
If InStr(R.Name, "Common Tables") > 0 Then Application.References.Remove R
Next R
Application.References.AddFromFile source
x = 0
Set TDefs = CurrentDb().TableDefs
For Each table In TDefs
If InStr(table.Connect, "Common Tables") = 0 Then GoTo NT
table.Connect = ";DATABASE=" & source
table.RefreshLink
x = x + 1
NT:
Next table
Finish:
MsgBox "remapped " & x & " tables"
End Function`enter code here`
Here's a function I use to allow the user to browse to a file and select it. You can call this function to get a file name in the prior function instead of getting it from the table.
Public Function Get_File(Optional ftype = "xls")
Dim fd As Object
Const msoFileDialogFolderPicker = 4
Const msoFileDialogFilePicker = 3
Const msoFileDialogViewDetails = 2
'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.AllowMultiSelect = False
fd.ButtonName = "Select"
fd.InitialView = msoFileDialogViewDetails
fd.Title = "Select File"
fd.InitialFileName = "MyDocuments\"
fd.Filters.Clear
fd.Filters.Add "Files", "*." & ftype & "*"
'Show the dialog box and get the file name
If fd.Show = -1 Then
Get_File = fd.SelectedItems(1)
Else
Get_File = ""
End If
End Function
Related
I have an Access database that opens multiple instances of 2 reports. The quantity depends on how many student registrations is captured per training run. This may be up to 25, meaning that when the user click on the "Print Documents" button, 25 instances of the 2 reports are opened. The first report is a student registration form, and the second is a indemnity form. Both these forms has certain data on them, like the personal details.
Opening the multiple reports is no issue. The first report is opened with the below code:
Z = 1
While Not Rst3.EOF
Set rpt(Z) = New Report_Rpt_StudentReg
rpt(Z).Visible = True
rpt(Z).Caption = "Student Registation " & Rst3.StudentID
'Append it to the collection.
clnClient.Add Item:=rpt(Z), Key:=CStr(rpt(Z).hwnd)
Rst3.MoveNext
Z = Z + 1
Wend
In the report Rpt_StudentReg On Load, there are code running to with SQL statements to retrieve all the data and fill the fields on the report. The second report (Waiver) is opened from within the first report with similar code below:
Set rptWaiver(Z) = New Report_Rpt_Indemnity
rptWaiver(Z).Visible = True
rptWaiver(Z).Caption = "Indemnity " & Rst3.StudentID
'Append it to our collection.
clnClient.Add Item:=rptWaiver(Z), Key:=CStr(rptWaiver(Z).hwnd)
My issue is none of the data is dispalyed on any of the reports.
If I run a single instance, everything is fine and the relevant data is displayed.
Your assistance is appreciated.
Thanks
Deon
I am opening multiple instances with no issues. In the report's On Load Event, there is code running each time the report is opened. I use SQL to retrieve the data from the tables. Debugging the code, retrieves the correct data, but the data is not on the report when it is opened. The On Load event code as follows:
Private Sub Report_Load()
Set Dbs = CurrentDb: Set Dbs1 = CurrentDb
Select Case Mode
Case "WithData"
If MyMode = "Certification" Then
SQL1 = "SELECT StudentID FROM Tbl_Certification WHERE CertNumber = " & Rst3!CertNumber & ";"
Set Rst1 = Dbs1.OpenRecordset(SQL1)
SQL = "SELECT * FROM Tbl_StudentReg WHERE IDNumber = " & Rst1!StudentID & ";"
Set Rst = Dbs.OpenRecordset(SQL)
Rst1.Close
Else
SQL = "SELECT * FROM Tbl_StudentReg WHERE IDNumber = " & Forms!Frm_StudentReg_Edit.IDNumber & ";"
Set Rst = Dbs.OpenRecordset(SQL)
End If
Set Rst = Dbs.OpenRecordset(SQL)
Me.FirstName = Rst!FirstName
Surname = Rst!Surname
PrevSurname = Rst!PrevSurname
IDNumber = Rst!IDNumber
BirthDate = Rst!BirthDate
AltIDNumber = Rst!AltIDNumber
AltIDType1 = Rst!AltIDType
'-------------------
SQL1 = "SELECT * FROM Tbl_AltID WHERE AltID = " & Rst!AltIDType & ";"
Set Rst1 = Dbs1.OpenRecordset(SQL1)
AltIDTypeDescr1 = Rst1!AltIDDescr
'-----------------------------
Nationality1 = Rst!Nationality
SQL1 = "SELECT * FROM Tbl_Nationality WHERE NationalityNo = " & Rst!Nationality & ";"
Set Rst1 = Dbs1.OpenRecordset(SQL1)
NationalityDescr1 = Rst1!NationalityDescr
'-------------------------------
When the reports are opened for preview, there is no data in the reports. They are all blank.
I have requirements as below :
There is a folder named BATCH inside D:// drive of my PC.
Now this D://BATCH contains excel files with any random names. Every excel file has only one record.
I have to create .exe file or any Desktop Application which lets the user to browse the BATCH folder and then can upload the content or data from the excel files to our Server. We have to put the excel data into JSON and then have to upload it to the server.
One more thing is that If I have uploaded data from 3 files and then again user tries to upload by selecting the folder, data which are new or not uploaded only those data should be upload. The data in BATCH folder is generating daily with connected machine.
My background is for Web and Mobile development. So, little bit confused of achieving this thing as explained above.
So, How can I achieve this? Which technology I have to use or which are the tools that can be useful?
Thanks for the support.
There are probably a bunch of ways to skin this cat. Maybe import everything from all Excel files in the folder into one single Excel file, and export this to SQL Server. Just a thought.
Sub InsertInto()
'Declare some variables
Dim cnn As adodb.Connection
Dim cmd As adodb.Command
Dim strSQL As String
'Create a new Connection object
Set cnn = New adodb.Connection
'Set the connection string
cnn.ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=Northwind;Data Source=Server_Name"
'Create a new Command object
Set cmd = New adodb.Command
'Open the Connection to the database
cnn.Open
'Associate the command with the connection
cmd.ActiveConnection = cnn
'Tell the Command we are giving it a bit of SQL to run, not a stored procedure
cmd.CommandType = adCmdText
'Create the SQL
strSQL = "UPDATE TBL SET JOIN_DT = '2019-12-10' WHERE EMPID = 2"
'Pass the SQL to the Command object
cmd.CommandText = strSQL
'Execute the bit of SQL to update the database
cmd.Execute
'Close the connection again
cnn.Close
'Remove the objects
Set cmd = Nothing
Set cnn = Nothing
End Sub
Just to embellish my original answer a bit...you can easily import data from multiple excel files in a folder, into one single Excel file, using a concept like the one below.
Sub Basic_Example_1()
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount As Long, Fnum As Long
Dim mybook As Workbook, BaseWks As Worksheet
Dim sourceRange As Range, destrange As Range
Dim rnum As Long, CalcMode As Long
'Fill in the path\folder where the files are
MyPath = "C:\Users\Ron\test"
'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If
'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xl*")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If
'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop
'Change ScreenUpdating, Calculation and EnableEvents
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
'Add a new workbook with one sheet
Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
rnum = 1
'Loop through all files in the array(myFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
On Error GoTo 0
If Not mybook Is Nothing Then
On Error Resume Next
With mybook.Worksheets(1)
Set sourceRange = .Range("A1:C1")
End With
If Err.Number > 0 Then
Err.Clear
Set sourceRange = Nothing
Else
'if SourceRange use all columns then skip this file
If sourceRange.Columns.Count >= BaseWks.Columns.Count Then
Set sourceRange = Nothing
End If
End If
On Error GoTo 0
If Not sourceRange Is Nothing Then
SourceRcount = sourceRange.Rows.Count
If rnum + SourceRcount >= BaseWks.Rows.Count Then
MsgBox "Sorry there are not enough rows in the sheet"
BaseWks.Columns.AutoFit
mybook.Close savechanges:=False
GoTo ExitTheSub
Else
'Copy the file name in column A
With sourceRange
BaseWks.cells(rnum, "A"). _
Resize(.Rows.Count).Value = MyFiles(Fnum)
End With
'Set the destrange
Set destrange = BaseWks.Range("B" & rnum)
'we copy the values from the sourceRange to the destrange
With sourceRange
Set destrange = destrange. _
Resize(.Rows.Count, .Columns.Count)
End With
destrange.Value = sourceRange.Value
rnum = rnum + SourceRcount
End If
End If
mybook.Close savechanges:=False
End If
Next Fnum
BaseWks.Columns.AutoFit
End If
ExitTheSub:
'Restore ScreenUpdating, Calculation and EnableEvents
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub
See the link below for some ideas of how to get data from several Excel files/sources, consolidate into one single file/source.
http://www.rondebruin.nl/win/s3/win008.htm
Keep an open mind about this kind of stuff. There are several other ways to do essentially the same kind of thing.
The question is too broad and you can achieve your requirement in many ways.
If you consider using c# you can develop a WPF or Winforms Project.
You will need to follow these basic steps
A function to browse and pick your file like FolderBrowserDialog available in System.Windows.Forms. In case you are using WPF you have to add reference to the library
Read the excel contents. In this case you may need references to any library/nuget package like Epplus, Microsoft.Office.Interop.Excel, LinqToExcel or ExcelLibrary
Convert data to json format using Newtonsoft.Json nuget package
Upload or save data to SQL Server - Here you would need a connection string to the database and save the same in your .config file. you can use ADO, linq to sql etc for that.
Sample Code
OpenFileDialog openFileDialog = new OpenFileDialog();
openFileDialog.Filter = "Excel files (*.xls)|*.csv|All files (*.*)|*.*";
if (openFileDialog.ShowDialog()== DialogResult.OK)
{
//Open file and read contents
var excelFile = new LinqToExcel.ExcelQueryFactory(path);
var query =
from row in excelFile.Worksheet("Sheet1")
let item = new
{
Column1 = row["Column1"].Cast<string>(),
Column2 = row["Column2"].Cast<int>(),
}
select item;
foreach (var item in query)
{
MyCustomClass myClass = new MyCustomClass();
myClass.Column1 = item.Column1;
myClass.Column2 = item.Column2;
//Do something
}
//convert to json
// Save to database
}
I want to browse/select a database file through an Access form and run a query on it based on the file path of the selected database file. I have tried like this:
SELECT *
FROM ExternalTableName IN '[Forms]![MyForm]![SelectedFilePath]'
WHERE Condition
...but that didn't work however this SQL did work:
SELECT *
FROM ExternalTableName IN 'C:\users\desktop\filename.mdb'
WHERE Condition
For browsing the file, I used this VBA snippet:
Private Sub cmd1()
Dim fd As FileDialog
Dim oFD As Variant
Dim fileName As String
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.ButtonName = "Select"
.AllowMultiSelect = False
.Filters.Add "Access Files", "*.mdb", 1
.Title = "Choose Text File"
.InitialView = msoFileDialogViewDetails
.Show
For Each oFD In .SelectedItems
fileName = oFD
Next oFD
On Error GoTo 0
End With
'~~> Change this to the relevant TextBox
Me.TextFieldName = fileName
Set fd = Nothing
End Sub
Edit:
To query a table located in an MDB that the user selects from a File Open dialog, the simplest way (while avoiding additional References) is like this:
Option Explicit
Sub testQueryExternalTable()
'displays RecordCount from specified table, selected database
Const tableName = "tblLog"
Const defaultPath = "c:\users\" 'default path OR path+filename
Dim rs As Recordset, fName As String, sql as String
fName = getFileOpenDialog(defaultPath) 'get filename
If fName = "" Then MsgBox "You clicked cancel!": Exit Sub
sql = "select * from " & tableName & " in '" & fName & "'"
Set rs = CurrentDb.OpenRecordset( sql ) 'query the table
With rs
.MoveLast 'count records
MsgBox .RecordCount & " records found"
.Close 'close recordset
End With
Set rs = Nothing 'always clean up objects when finished
End Sub
Function getFileOpenDialog(defaultPath As String) As String
'returns filename selected from dialog ("" if user Cancels)
With Application.FileDialog(3)
.Title = "Please select a database to query" 'set caption
.InitialFileName = defaultPath 'default path OR path+filename
.AllowMultiSelect = False 'maximum one selection
.Filters.Clear 'set file filters for drop down
.Filters.Add "All Files", "*.*" '(in reverse order)
.Filters.Add "Access Databases", "*.mdb" '(last = default filter)
If .Show = True Then getFileOpenDialog = .SelectedItems(1) 'show dialog
End With
End Function
More Information:
MSDN : Application.FileDialog Property (Access)
MSDN : FileDialog.InitialFileName Property
MSDN : Accessing External Data with MS Access
MSDN : Database.OpenRecordset Method (DAO)
Original Answer:
It's easier (and more efficient) to use Access's built-in functionality rather than recreating it in VBA.
(Click to enlarge images)
The first option imports, and the seconds option emphasized textlinks without importing. Once the table is linked you can work with it in VBA or queries as if it's a local table.
Using Access 2010...
I am trying to write/find a script that performs the following steps:
Run script
Dialogue window opens (essentially Windows Explorer) allowing user to navigate to and select an xls for importing
User selects xls
Access imports this xls into a table called Import
Script ends
I have found a snippet to allow for a file Explorer window to open:
Dim f As Object
Set f = Application.FileDialog(3)
f.AllowMultiSelect = False
f.Show
But I can't figure out how to join this to something like:
DoCmd.TransferSpreadsheet acImport, 10, "Import", "FILEPATH", True, ""
I'd greatly appreciate any assistance. Thank you much.
FileDialog is an application object with a few components including title of dialog window, initial default path, file type filter to guide users on correct type and one important item is its variant array, .SelectedItems() which you use to pull the string of selected file(s).
Dim f As Object
Set f = Application.FileDialog(3)
f.AllowMultiSelect = False
f.Title = "Title of Dialog Window"
f.InitialFileName = "C:\Set\Default\Path"
f.Filters.Clear
f.Filters.Add "PDF files", "*.pdf"
f.FilterIndex = 1
If f.Show = -1 Then
strFilePath = f.SelectedItems(1)
Else
'The user pressed Cancel.
MsgBox "No file Selected", vbExclamation
strFilePath = Null
End if
Set fd = Nothing
From there you can pass strFilePath into your import command:
DoCmd.TransferSpreadsheet acImport, 10, "Import", strFilePath, True, ""
I have a query "myQuery" that returns more than 65,000 records, and as such, cannot be exported to one .xlsx file.
I'm attempting to break up this output to multiple files.
I'm still very much a beginner with VBA, but I've put the following together as best I can from research. This code is intended to iterate through the queried data, then output a new file for each 65,000 records.
Private Sub btnfrm1export_Click()
Dim outputFileName As String
Dim dlgOpen As FileDialog
Dim numFiles As Integer
Dim rs As String
Dim numr As Integer
Dim sql As String
Dim rec As Recordset
'Allows user to pick destination for files and gives value to sItem.
Set dlgOpen = Application.FileDialog(msoFileDialogFolderPicker)
With dlgOpen
.Title = "Select a Folder"
.AllowMultiSelect = False
If .Show <> -1 Then
sItem = .SelectedItems(1)
End If
End With
'Counts the records in myQuery to give the number of files needed to numFiles, assuming 60,000 records per file.
Set rec = CurrentDb.OpenRecordset("myQuery")
numFiles = Round(rec.RecordCount / 60000, 0)
numr = 1
' Changes the SQL of the query _vba in the current Database to select 60000 records from myQuery
rs = "SELECT TOP 60000 myQuery.* FROM myQuery"
CurrentDb.QueryDefs("_vba").sql = rs
'Defines SQL for clearing top 60000 (used in the following loop).
sql = "DELETE TOP 60000 myQuery.* FROM myQuery"
'Loops once to create each file needed
Do While numFiles > 0
'Sets a file name based on the destination folder, the file number numr, and information from a combobutton cbo1 on Form frm1.
outputFileName = sItem & "\" & Forms!frm1!cbo1 & "_Report_Pt" & numr & "_" & Format(Date, "yyyyMMdd") & ".xlsx"
'Outputs top 60000 of myQuery records to an excel file.
DoCmd.OutputTo acOutputQuery, "_vba", acFormatXLSX, outputFileName
numFiles = numFiles - 1
numr = numr + 1
'Deletes top 60000 from myQuery.
CurrentDb.Execute sql
Loop
End Sub
However, I'm getting:
Run-time error '2302': Microsoft Access can't save the output data to the file you've selected.
at DoCmd.OutputTo acOutputQuery, "_vba", acFormatXLSX, outputFileName
I do need this to be automated in vba and without pop-ups, etc. Any suggestions to make my code more efficient and proper is appreciated, but the REAL question is how to eliminate the error with DoCmd.OutputTo or make this work.
Thanks for any and all help!
Although the subject line concerns trying to output multiple Excel files, the real issue is trying to create an Excel file from an Access table or query which contains more than 65,000 rows - by using VBA. If VBA is NOT a requirement, then you can export a query or table by right-clicking on the object name, selecting export, then Excel. DO NOT check the box for 'Export data with formatting...' and it will work.
The code shown below was found at: http://www.myengineeringworld.net/2013/01/export-large-access-tablequery-to-excel.html (Created By Christos Samaras) and will properly export a large table/query to Excel
Option Compare Database
Option Explicit
Sub Test()
'Change the names according to your own needs.
DataToExcel "Sample_Table", "Optional Workbook Path", "Optional Target Sheet Name"
'Just showing that the operation finished.
MsgBox "Data export finished successfully!", vbInformation, "Done"
End Sub
Function DataToExcel(strSourceName As String, Optional strWorkbookPath As String, Optional strTargetSheetName As String)
'Use this function to export a large table/query from your database to a new Excel workbook.
'You can also specify the name of the worksheet target.
'strSourceName is the name of the table/query you want to export to Excel.
'strWorkbookPath is the path of the workbook you want to export the data.
'strTargetSheetName is the desired name of the target sheet.
'By Christos Samaras
'http://www.myengineeringworld.net
Dim rst As DAO.Recordset
Dim excelApp As Object
Dim Wbk As Object
Dim sht As Object
Dim fldHeadings As DAO.Field
'Set the desired recordset (table/query).
Set rst = CurrentDb.OpenRecordset(strSourceName)
'Create a new Excel instance.
Set excelApp = CreateObject("Excel.Application")
On Error Resume Next
'Try to open the specified workbook. If there is no workbook specified
'(or if it cannot be opened) create a new one and rename the target sheet.
Set Wbk = excelApp.Workbooks.Open(strWorkbookPath)
If Err.Number <> 0 Or Len(strWorkbookPath) = 0 Then
Set Wbk = excelApp.Workbooks.Add
Set sht = Wbk.Worksheets("Sheet1")
If Len(strTargetSheetName) > 0 Then
sht.Name = Left(strTargetSheetName, 34)
End If
End If
'If the specified workbook has been opened correctly, then in order to avoid
'problems with other sheets that might contain, a new sheet is added and is
'being renamed according to the strTargetSheetName.
Set sht = Wbk.Worksheets.Add
If Len(strTargetSheetName) > 0 Then
sht.Name = Left(strTargetSheetName, 34)
End If
On Error GoTo 0
excelApp.Visible = True
On Error GoTo Errorhandler
'Write the headings in the target sheet.
For Each fldHeadings In rst.Fields
excelApp.ActiveCell = fldHeadings.Name
excelApp.ActiveCell.Offset(0, 1).Select
Next
'Copy the data in the target sheet.
rst.MoveFirst
sht.Range("A2").CopyFromRecordset rst
sht.Range("1:1").Select
'Format the headings of the target sheet.
excelApp.Selection.Font.Bold = True
With excelApp.Selection
.HorizontalAlignment = -4108 '= xlCenter in Excel.
.VerticalAlignment = -4108 '= xlCenter in Excel.
.WrapText = False
With .Font
.Name = "Arial"
.Size = 11
End With
End With
'Adjusting the columns width.
excelApp.ActiveSheet.Cells.EntireColumn.AutoFit
'Freeze the first row - headings.
With excelApp.ActiveWindow
.FreezePanes = False
.ScrollRow = 1
.ScrollColumn = 1
End With
sht.Rows("2:2").Select
excelApp.ActiveWindow.FreezePanes = True
'Change the tab color of the target sheet.
With sht
.Tab.Color = RGB(255, 0, 0)
.Range("A1").Select
End With
'Close the recordset.
rst.Close
Set rst = Nothing
Exit Function
Errorhandler:
DoCmd.SetWarnings True
MsgBox Err.Description, vbExclamation, Err.Number
Exit Function
End Function