I was trying something more fancy and did post on accessforums, where I got got no responses and on programmers access, where I got links to more reading material, but which did not help me - probably due to my lack of VBA expertise.
I have done lots of other programming like PHP and Arduino, but VBA is new for me, although I been watching hours of videos, they don't quite cover what I want to do.
After 4 days of researching an failed attempts, I have simplified my approach and I would appreciate some "real" help with actual code.
Scenario:
I have multiple Excel source file with 9 tabs each.
All the source files are in the same directory, (not in the same directory as the database)
Only one source is ever linked.
Each tab of the source file is a linked table within Access.
Objective:
I wish regularly switch source files.
Method:
I want to replace only the connect file property (i.e. the full file path) for each of the 9 sheets/tabs that use the particular file.
The full path must be "picked up" from my form and applied on an event e.g. on closing of form.
Progress:
I have built a form in which I can enter the file name to use and which calculates the full path to the file in question.
I have a button on the form, which is used to close the form.
Code:
Private Sub Form_Close()
Dim dbs As Database
Dim tdf As TableDef
Dim sfl As String
Dim basePath As String
Dim sName As String
Set dbs = CurrentDb
Set sfl = "SourceData_"
Set sName = "JoeSmith"
Set basePath = "D:\Databases\BOM Consolidator\data_source"
' Loop through all tables in the database.
For Each tdf In dbs.TableDefs
If InStr(10, tdf.Connect, sfl, 1) > 10 Then
tdf.Connect = ";DATABASE=" & basePath & sfl & sName & "\" & dbs
Err = 0
On Error Resume Next
tdf.RefreshLink ' Relink the table.
If Err <> 0 Then
End If
End If
Next tdf End Sub
In the above I am entering the path etc directly just to get it working first.
Access froze :(
Help would be appreciated.
Posting this before I try a restart.
After a restart it is not freezing.
It is saying I have a missing object.
The first line is highlighted in yellow, so I assume something must go in the parenthesis, but no idea what.
If it was a function, I would normally put a variable that is not declared inside the function. This being a subroutine, I was not expecting it to ask for something...
Ultimately I will turn it into a function, sothat I can provide the file name.
A clue to what is needed on the first line please...?
Oh also I am using "Code Builder" - is that the correct option to use with closing a form?
Related
I have a problem with Excel (ODBC / Access). I would like to refresh data from any folder in my computer. I have file which I use from Desktop, but I would like to refresh data from the same file when it will be move to documents, etc. Please could you provide what I should do?
I have a file connection as below:
DSN=Excel Files;DBQ=C:\Users\User\Desktop\Task1\SalesBudget2018.xlsx;DefaultDir=C:\Users\User\Desktop\Task1;DriverId=1046;MaxBufferSize=2048;PageTimeout=5;
Thank you.
EDIT1: Thank you. I tried use your solution and I received error: "run time error 2147467259 Database or object is read-only", my code below. The bug is related to ".Open" line:
Sub RefreshData()
Dim CreateNew As Object
Dim RunSELECT As Object
Dim Data As String
Dim SQL As String
FolderPath = ActiveWorkbook.path
Path = Left(FolderPath, InStrRev(FolderPath, "\") - 1)
Set CreateNew = CreateObject("ADODB.Connection")
With CreateNew
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & Path & "\SalesBudget2018.xlsx" & ";" & "Extended Properties=""Excel 12.0 Xml;HDR=YES;"";"
.Open
End With
'Run SQL
SQL = "SELECT * FROM [twRynki$]"
Set RunSELECT = cn.Execute(SQL)
Do
output = output & RunSELECT(0) & ";" & RunSELECT(1) & ";" & RunSELECT(2) & vbNewLine
Debug.Print RunSELECT(0); ";" & RunSELECT(1) & ";" & RunSELECT(2)
rs.Movenext
Loop Until rs.EOF
End Sub
Your path actually is not relative at all. But ACE/JET data engine does not support relative paths anyway.
A relative path would be
\Data\mydb.mdb
So, above would be one folder up called data from current location. And one folder down using relative would be:
..\Data\mydb.mdb
However, with ACE/Access relative paths are not supported. However, what we do when we want software to work say from the current folder? We simple get and use the full path name ON APPLICATION start up. So, you can get/grab the current folder. In Excel VBA you can use this:
ActiveWorkbook.Path
So above will give you the current path. And thus you use that in code to set the connection string. So, even in access, if we want the software to work in any folder? We simply get/grab the full path name on startup. As a result, the software works in any folder and you effective get relative address in that you "don't care" where the software is placed, since you always get/grab the full path name anyway. So, with above, you could append a folder name called data
ActiveWorkbook.Path & "\Data\Mydb.accdb"
So, from the current workbook location, you could always have a folder called data, and inside that folder you can have your database. So, in effect you do get relative addressing, but you always pulling the full path name of the current workbook as per above.
The end result is you don't miss not having some form of relative addressing since you don't need to with this approach.
The above is for Excel VBA. To get current path from Access VBA? You can use this:
currentproject.Path
So, your connection string to Excel could be this:
dim strExcelPath as string
strExcelPath = CurrentProject.Path & "\Task1\SalesBudget2018.xlsx"
It not clear if the access application is in the SAME folder as task1?
Assuming yes, then this would work:
strExcelPath = CurrentProject.Path & "\SalesBudget2018.xlsx"
So, now the folder can be on the desktop, my documents - it will not matter. You can thus use above as part of your connection string. It not clear if you linking to Excel (linked table), or you using VBA and say ADO code. However, it really don't matter. On application startup, you get the above connection string, check it against the linked table -- if same then do nothing. If different, then you re-link that one table. Thus you ONLY re-link one time if the folder been moved. And no matter where you move the folder? As long as you assume the Excel sheet is in the same folder as the access app, then you good to go. And as noted, you could add a sub folder say ExcelSheets to above. And once again, no matter where you move this folder with the Access part, as long as the sub folder is in the same dir/folder, then this will work - despite you not having relative addressing.
It's been years since I've used Visual Basic. I downgraded from 2017 to 2010 (The version I was using while I was in school). I figured VB would be the best way to attempt a solution. (Although I'm sure there are other languages that would do it as well.)
I'm looking to get back into programming. Let me get to the problem.
My friend has an ever growing amount of text documents in a folder, and he wants a program to choose one at random, and open it.
I thought I'd put a TextBox with a Button that would let him open the folder where he stores his files. Then this program would read the number of text files in that folder, and randomly generate a number between one and that number, select, and open the document with its default program (if it's text, notepad; if it's DocX then word.)
I've been sitting at a blinking cursor for 45 minutes. I've gone on YouTube for help with this project.
Any advice, or help you guys can give me? Does this need to be simplified?
That sounds like a reasonable strategy to me.
It might be worth displaying some sort of progress to the user, say by putting the name of current file name being read into the status bar, in case there's a long delay reading the file names due to the large number of files in the folder, and/or a slow-running network drive. If you do this, remember to put a DoEvents into your loop to allow screen updates to display.
There's a separate thread on how to open files in their native handler here.
Hope this helps - good luck!
Option Explicit
Public oFSO As Object
Public arrFiles()
Public lngFiles As Long
Sub Main()
Dim sPath As String
sPath = InputBox("Enter folder path", "Folder path")
' clear starting point
lngFiles = 0
Erase arrFiles
Set oFSO = CreateObject("Scripting.FileSystemObject")
Call recurse(sPath)
Randomize
Dim lngRandomFileNumber As Long
lngRandomFileNumber = CLng(lngFiles * Rnd) + 1
MsgBox "This is random file, that will be opened: " & arrFiles(lngRandomFileNumber)
Call CreateObject("Shell.Application").Open(arrFiles(lngRandomFileNumber))
End Sub
Sub recurse(sPath As String)
Dim oFolder As Object
Dim oSubFolder As Object
Dim oFile As Object
Set oFolder = oFSO.GetFolder(sPath)
'Collect file information
For Each oFile In oFolder.Files
lngFiles = lngFiles + 1
ReDim Preserve arrFiles(lngFiles + 1)
arrFiles(lngFiles) = sPath & "\" & oFile.Name
Next oFile
'looking for all subfolders
For Each oSubFolder In oFolder.SubFolders
'recursive call
Call recurse(oSubFolder.path)
Next oSubFolder
End Sub
You can paste this code in any VBA supporting application (MS Access, MS Excel, MS Word), call VBA editor (Shift + F11) and paste this code. After that press F5 and select Main() function. You'll see prompt to enter folder path, and after that you would get random file path.
I think it should be understandable in practice to see what program do
Updated: #Belladonna mentioned it clearly, to open file in default program.
NB: This code is passes through subfolders also, if you want to exclude subfolders, you should comment the recursive call block in recurce function
Scenario
I have an excel file that contains data. There are multiple users accessing the file at the same time.
Problem
There will be problem if multiple users tried to input data to that excel file at the same time due to only one user is allowed to open the file at one time
Question
Is there any way whereby I can update the excel file (Eg: add a value to a cell, delete a value from a cell, find a particular cell etc) without opening it so that multiple users can update it at the same time using excel VBA?
I went to the direction of using shared files. But later found out to be excel shared files are very buggy. If use shared file, excel/macro can be very slow, intermittent crashes and sometime the whole file may get corrupted and could not be opened or repaired afterwards. Also depends on how many users use the file, the file size can grow quite big. So it is best not to use shared workbook. Totally not worth trying. Instead if need multiple users to update data simultaneously, it is better to use some database such as MSAccess, MSSql (Update MSSQL from Excel) etc with excel. For my situation since number of users are less, I didn't use any database, instead put a prompt for the user to wait until the other user close that file. Please see the codes below to check if a file is opened and if so, to prompt user. I got this code from stack overflow itself and I modified to suit my needs.
Call the module TestFileOpened as below.
Sub fileCheck()
Call TestFileOpened(plannerFilePathTemp)
If fileInUse = True Then
Application.ScreenUpdating = True
Exit Sub
End If
End Sub
Here plannerFilePathTemp is the temporary file location of your original file. Whenever an excel file opened, a temp file will be created. For example, your original file location is as below
plannerFilePath = "C:\TEMP\XXX\xxx.xlsx"
Thus your temporary file location will be
plannerFilePathTemp = "C:\TEMP\XXX\~$xxx.xlsx"
or in other words, temporary file name will be ~$xxx.xlsx
The following codes will be called upon Call TestFileOpened(plannerFilePathTemp)
Public fileInUse As Boolean
Sub TestFileOpened(fileOpenedOrNot As String)
Dim Folder As String
Dim FName As String
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(fileOpenedOrNot) Then
fileInUse = True
MsgBox "Database is opened and using by " & GetFileOwner(fileOpenedOrNot) & ". Please wait a few second and click again", vbInformation, "Database in Use"
Else
fileInUse = False
End If
End Sub
Function GetFileOwner(strFileName)
Set objWMIService = GetObject("winmgmts:")
Set objFileSecuritySettings = _
objWMIService.Get("Win32_LogicalFileSecuritySetting='" & strFileName & "'")
intRetVal = objFileSecuritySettings.GetSecurityDescriptor(objSD)
If intRetVal = 0 Then
GetFileOwner = objSD.Owner.Name
Else
GetFileOwner = "Unknown"
End If
End Function
I encountered Out of memory issues also when used shared files. So during the process, I figured out the following methods to minimize memory consumption
Some tips to clear memory
Prior to being asked to migrate to SharePoint, I was using a collection of .xlsm files to set project teams up to manage projects. My Project Manager file included a macro that would go to a designated folder and create hyperlinks for all current project files. I've saved the collection of .xlsm files on SharePoint, but when I run the macro below (which I found here - Thank you!), I receive an error related to the "Set xFolder = xFSO.GetFolder(xPath)" line. Any help would be great. I've read several posting that may have the answer and tried several adjustments to the code, with no luck.
Sub Create_Hyperlinks_for_all_Current_Projects()
Range("B8:D38").Clear
MsgBox "Once you click OK, an explorer box will appear. Select the folder
containing all the CSTPs and then click OK again. HINT: The folder
containing all the CSTPs should be in the same folder this document was in
and should be called ''CSTPs''. Links to all CSTPs will then appear in the
white box on the Manager Menu."
Dim xFSO As Object
Dim xFolder As Object
Dim xFile As Object
Dim xFiDialog As FileDialog
Dim xPath As String
Dim I As Integer
Set xFiDialog = Application.FileDialog(msoFileDialogFolderPicker)
With xFiDialog
.InitialFileName = ThisWorkbook.Path
End With
If xFiDialog.Show = -1 Then
xPath = xFiDialog.SelectedItems(1)
End If
Set xFiDialog = Nothing
If xPath = "" Then Exit Sub
Set xFSO = CreateObject("Scripting.FileSystemObject")
Set xFolder = xFSO.GetFolder(xPath)
For Each xFile In xFolder.Files
I = I + 2
ActiveSheet.Hyperlinks.Add Cells(I + 6, 2), xFile.Path, , , xFile.Name
Next
End Sub
I hope you find the following notes helpful.
They summarize the outcomes from several weeks of frustration.
If you are using SP365,
then the filesystemobject
no longer works very well, if at all.
I had hundreds of macros dependent on the FSO.
These have all worked great up until my organization migrated to SP365 :o(
Now they only work if I manually click
the Open Explorer button, in SP, first.
Opening Explorer provides Win Explorer with the required permissions to access SP.
This in turn provides the FSO with the required permissions to access SP.
But...in my case...FSO only works for a while.
For my first work around...
I rolled out a prototype app, which used a macro to automate
opening IE, opening Win Explorer and initializing permissions for the FSO
All worked great on my machine, for about an hour,
then some kind of timeout took me back to square one.
Colleagues on other machines experienced a range of FSO behaviours.
From all working ok. To having to rerun the connection macro every 30 seconds.
To nothing working at all.
I then invested time trying to update macros to connect to SP as a network drive.
Again, this is a process that I have used for years, up until migration to SP365.
Again, success connecting to SP365 seems to be very machine dependent.
In the end...with respect to my own requirements...
My work around was to create an SP view that lists all files.
Then use the Export to Excel option in SP to create an Excel data query.
Then copy the query into an Excel file that I refer to as Config.xlsx.
Then use Excel RefreshAll to update the list of files, each time a list is required.
Its not very elegant...but, it works ;o)
As I say....I hope this helps you / someone.
Feel free to connect on LinkedIn if you require any followup advice.
Peter,
LinkedIn name DrPeterEHSmee
I have been using folder browser for VBA, I could paste the code of it, but bottom line is that I get returned file name as a string.
Is there any way to access drawing properties (i.e number of layouts) without open?
Public Sub TestFileDialog()
dwgname = FileBrowseOpen("C:", "*", ".dwg", 1) 'dwgname is typeof string
End Sub
Its only the first step (use of FileBrowseOpen function is shown, but also i can use FolderBrowse and collect all .dwg inside of folder),actually i had in mind to batch export all layouts of selected .dwgs to currenty open one. Is there any chance for that?
To effectively read a .dwg file you'll need to open AutoCAD, otherwise the information is not accessible. Some properties may be, such as author, but not number of layouts...
But you can use AutoCAD Console (accoreconsole.exe) to run a headless AutoCAD and use APIs to read any information you need. This is really fast for reading lot's of files and the user will not see it running (but it needs to be installed anyway).
http://aucache.autodesk.com/au2012/sessionsFiles/3338/3323/handout_3338_CP3338-Handout.pdf
you could stay in VBA and use ObjectDBX
it leads to a very similar approach as accoreconsole.exe on in .NET does, i.e you won't see any drawing open in UI since it works on the database itself
It requires adding library reference (Tools->References) to "AutoCAD/ObjectDBX Common XX.Y Type Library", where "XX.Y" is "19.0" for AutoCAD 2014
a minimal functioning code is
Sub main()
Dim myAxDbDoc As AxDbDocument
Dim FullFileName As String
FullFileName = "C:\..\mydrawing.dwg" '<== put here the full name of the file to be opened
Set myAxDbDoc = AxDb_SetDrawing(FullFileName)
MsgBox myAxDbDoc.Layers.Count
End Sub
Function AxDb_SetDrawing(FullFileName As String) As AxDbDocument
Dim DBXDoc As AxDbDocument
Set DBXDoc = Application.GetInterfaceObject("ObjectDBX.AxDbDocument.19") '<== place correct AutoCAD version numeber ("19" works for AutoCAD 2014)
On Error Resume Next
DBXDoc.Open FullFileName
If Err <> 0 Then
MsgBox "Couldn't open" & vbCrLf & vbCrLf & FullFileName, vbOKOnly + vbCritical, "AxDB_SetDrawing"
Else
Set AxDb_SetDrawing = DBXDoc
End If
On Error GoTo 0
End Function
Still, you must have one AutoCAD session running from which make this sub run! But you should have it since talked about "currently open" drawing