Can I share an MS-Access database application via Dropbox? - ms-access

I have a small Access application that only 3 or 4 people will ever use, but I want them to be able to use it from different locations. Only one person will use it at a time. They are a non-profit with little to no funding. They don't have a server and are currently sharing an Excel spreadsheet back and forth between all of them. The easiest thing I could think of doing was to upload the .accdb file to a Dropbox account and have them access it from there. I know that you can publish it to SharePoint, but all they have are local copies of Office. Are there any issues with doing the Dropbox thing or are there any better alternatives any of you could suggest?

I agree that using a Dropbox folder as a shared location could possibly work provided that only one person had the database open at any one time. If more than one person opened the database at the same time then when Dropbox went to sync the file it could clobber somebody else's changes, or have sync conflicts, or perhaps just get horribly confused.
If I was to try using this approach I certainly would not rely on telling users to "always check if somebody else is using the database before opening it" or "always open the database in Exclusive mode". Instead, I would use a little launcher script like the following VBScript to manage access to the database. It uses a second file extension (.Available or .IN_USE) to indicate the status of the database file, makes a local (not synced) copy, opens that copy in Access, and then copies the updated file back to the Dropbox folder so it can be synced.
Option Explicit
Dim WshShell, fso, f, AccessPath, DropboxFolder, WorkingFolder, DatabaseName
Const TemporaryFolder = 2
DropboxFolder = "C:\Users\Gord\Dropbox\dbStorage\"
DatabaseName = "myDatabase.accdb"
Set fso = CreateObject("Scripting.FileSystemObject")
WorkingFolder = fso.GetSpecialFolder(TemporaryFolder) & "\"
If fso.FileExists(DropboxFolder & DatabaseName & ".Available") Then
Set f = fso.GetFile(DropboxFolder & DatabaseName & ".Available")
f.Name = DatabaseName & ".IN_USE"
WScript.Echo "Copying database file to working folder..."
f.Copy WorkingFolder & DatabaseName
Set f = Nothing
Set WshShell = CreateObject("WScript.Shell")
AccessPath = WshShell.RegRead("HKEY_CLASSES_ROOT\Access.MDBFile\shell\Open\command\")
AccessPath = Left(AccessPath, InStr(AccessPath, "MSACCESS.EXE") + 12)
WScript.Echo "Launching Access..."
WshShell.Run AccessPath & " """ & WorkingFolder & DatabaseName & """", 1, True
WScript.Echo "Copying database file back to Dropbox folder..."
fso.CopyFile WorkingFolder & DatabaseName, DropboxFolder & DatabaseName & ".IN_USE"
Set f = fso.GetFile(DropboxFolder & DatabaseName & ".IN_USE")
f.Name = DatabaseName & ".Available"
Set f = Nothing
Else
If fso.FileExists(DropboxFolder & DatabaseName & ".IN_USE") Then
MsgBox "The database is currently in use. Try again later."
Else
MsgBox "The database could not be found."
End If
End If
Set fso = Nothing
The launcher could be invoked by a shortcut whose target is
CSCRIPT.EXE C:\wherever\launchMyDatabase.vbs

This is an enhanced version of Gord Thompsons script which tries to inform the user to help them do the "right thing".
It also deals with exceptional behaviour such as bad internet access (it encourages the user NOT to use it!) and it also deals with the script being terminated by the user once access has been opened)
' This uses a second file extension (.Available or .InUse) to indicate the status of the database file,
' makes a local (not synced) copy inthe temp folder and opens that copy in Access.
' The updated file is copied back to the Dropbox folder so it can be synced.
' A backup fodler and file can be created with a date in the filename if the suer chooses to.
'
' The launcher could be invoked by a shortcut whose target is
'
' CSCRIPT.EXE C:\!AA\OpenFMFtoolDatabase.vbs
' Or to debug (it can open in VS if VS has been setup right with an external tool)
' CSCRIPT.EXE /X C:\!AA\OpenFMFtoolDatabase.vbs
' ----------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------
' This file is used to open and backup the FMFtool university and Subject database
'
' It can be invoked by a shortcut whose target is CSCRIPT.EXE C:\!AA\OpenFMFtoolDatabase.vbs
'
' See the tag #DOTHESE below for constants that need to be changed for each specific user
'Option Explicit
' ----------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------
' Supporting functions
'
Function LPad(MyString, MakeStringThisLong, PadWithThisChar)
Dim n: n = 0
If MakeStringThisLong > Len(MyString) Then n = MakeStringThisLong - Len(MyString)
LPad = String(n, PadWithThisChar) & MyString
End Function
Function BuildDateForFile()
Dim TheMonth, TheDay
TheMonth = LPad(Month(Date), 2, "0")
TheDay = LPad(Day(Date), 2, "0")
BuildDateForFile = DatePart("yyyy", Now) & TheMonth & TheDay & "_"
End Function
' ----------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------
' ----------------------------------------------------------------------------------------
' Main Procedure
'
Sub OpenDatabase()
' -----------------------------------------------------------------
' -----------------------------------------------------------------
' USER / MACHINE SPECIFIC #DOTHESE
Const SupportEmail = "mr#harveyfrench.co.uk"
' This script may prompt the user to contact support using this email address.
Const DropboxFolder = "C:\!AA\DropBox\"
' A typical value is "C:\Users\Gord\Dropbox\dbStorage\" Note that it must END WITH a backslash
' It is set to the name of the LOCAL folder (ie a folder on the PC running this script) which is synced with dropbox
' (or any internet based file sharing system like Dropbox, Onedrive, GDrive, etc)
Const DatabaseCalled = "University and Subject Database"
' The name of the database file without the file extension (ie no .accdb)
Const DatabaseExtension = ".accdb"
' The file extension (eg .accdb)
' -----------------------------------------------------------------
' -----------------------------------------------------------------
' General constants
Const TemporaryFolder = 2
Const TAGForINUSE = ".InUse"
Const TAGForAVAILABLE = ".Available"
Const TAGForOldLocalFile = ".OldFile"
Dim WshShell, f, AccessPath, WorkingFolder, DatabaseName
Dim FileNameWhenInUse, FileNameWhenAvailable
Dim DropBoxInUse, DropBoxAvailable
Dim DropboxBackupFolder, DropboxBackupFileName, DropboxDONOTBackupFileName
Dim LocalFile, OldLocalFile
Dim blnOpenLocalFile
' -----------------------------------------------------------------
' Use these lines when delivering the code
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
' -----------------------------------------------------------------
' Use may use these lines when writing the code
'Dim fso As Scripting.FileSystemObject
'Set fso = New Scripting.FileSystemObject
' -----------------------------------------------------------------
' About files and folders
DatabaseName = DatabaseCalled & DatabaseExtension
FileNameWhenInUse = DatabaseName & TAGForINUSE
FileNameWhenAvailable = DatabaseName & TAGForAVAILABLE
DropBoxInUse = DropboxFolder & FileNameWhenInUse
DropBoxAvailable = DropboxFolder & FileNameWhenAvailable
DropboxBackupFolder = DropboxFolder & "Backups"
WorkingFolder = fso.GetSpecialFolder(TemporaryFolder) & "\"
' eg often: C:\Users\Harvey\AppData\Local\Temp\
LocalFile = WorkingFolder & DatabaseName
OldLocalFile = LocalFile & TAGForOldLocalFile
blnOpenLocalFile = False
' -----------------------------------------------------------------
' WARN User
'
If vbNo = MsgBox("This will open " & DatabaseName & vbCrLf & _
vbCrLf & _
"DO YOU HAVE ACCESS TO THE WEB?" & vbCrLf & _
vbCrLf & _
"Do not click YES unless you are sure you do as the web is needed to prevent other people from opening the above file while you have it open. " & vbCrLf & _
vbCrLf & _
"NOTE 1: It is OK to loose web access once the file is opened - but others will not be able to use it again until you have web access (and have closed the file)." & vbCrLf & _
vbCrLf & _
"NOTE 2: If you click YES and you do not have web accesss, either you or someone else WILL LOOSE ALL changes made to the file!)", vbYesNo) Then
Exit Sub
End If
' ---------------------------------------------------------------------------------
' ---------------------------------------------------------------------------------
'
' Main processing -
' The file is only opened if it is available (ie not in use by another person).
' It can also be opened if it is determined that the file was not copied back to the dropbox folder
' but was "accidentally" left in the temp folder
' When it is opened the file is renamed on dropbox to indicate it is unavailable
'
If fso.FileExists(DropBoxAvailable) Then
Set f = fso.GetFile(DropBoxAvailable)
' This renames the file on dropbox to be "InUse"
f.Name = FileNameWhenInUse
'
' Allow dropbox to upload the file ASAP (if possible, force dropbox to sync here )
'
WScript.Echo "Copying database file to temp folder..."
f.Copy LocalFile
Set f = Nothing
blnOpenLocalFile = True
Else
If fso.FileExists(DropBoxInUse) Then
If fso.FileExists(LocalFile) Then
MsgBox "The database was found locally and will be opened " & vbCrLf & _
vbCrLf & _
"(it had already been previoulsy opened by you, but not written back to the dropbox folder (perhaps a process crashed)."
blnOpenLocalFile = True
Else
MsgBox "The database is currently in use by someone else. Try again later."
blnOpenLocalFile = False
End If
Else
MsgBox "The database could not be found on dropbox " & vbCrLf & _
vbCrLf & _
"(Both " & TAGForINUSE & " and " & TAGForAVAILABLE & " versions are missing from dropbox!)."
If fso.FileExists(LocalFile) Then
MsgBox "A Copy of the file exists locally on your computer. " & vbCrLf & _
vbCrLf & _
"(The file will be opened and written back to dropbox as usual BUT - " & vbCrLf & _
"please email " & SupportEmail & " as this situation should not be arising!)."
blnOpenLocalFile = True
Else
If fso.FileExists(OldLocalFile) Then
MsgBox "A backup copy of the local file exists (know as the OldLocalFile)" & vbCrLf & _
vbCrLf & "Email support on " & SupportEmail & vbCrLf & _
"to find out what to do (as this is a really wierd situation)."
Else
MsgBox "A backup copy of the local file DOES NOT EXIST " & vbCrLf & _
vbCrLf & "Email support on " & SupportEmail & vbCrLf & _
"..but being honest you may be in a really bad pickle, but if you've been taking backups you'll be fine!"
End If
blnOpenLocalFile = False
End If
End If
End If
If blnOpenLocalFile Then
' ---------------------------------------------------------------------------------
' Take a daily backup
'
If Not fso.FolderExists(DropboxBackupFolder) Then
WScript.Echo "Creating backup folder."
fso.CreateFolder DropboxBackupFolder
End If
DropboxBackupFileName = DropboxBackupFolder & "\" & BuildDateForFile() & DatabaseName
DropboxDONOTBackupFileName = DropboxBackupFileName & ".NoBackup"
DropboxBackupFileName = DropboxBackupFileName & ".Backup"
If Not (fso.FileExists(DropboxBackupFileName)) And Not (fso.FileExists(DropboxDONOTBackupFileName)) Then
If vbYes = MsgBox("Do you want to take a daily backup? " & vbCrLf & _
vbCrLf & "(click YES if a lot of work has been done since the last backup was taken. " & vbCrLf & _
" If in doubt click YES)", vbYesNo) Then
WScript.Echo "Creating daily backup file."
fso.CopyFile LocalFile, DropboxBackupFileName
Else
' Create an empty text file to flag no backup is wanted that day
WScript.Echo "No daily backup file will be created."
fso.CreateTextFile (DropboxDONOTBackupFileName)
End If
End If
' ---------------------------------------------------------------------------------
' Open the file
'
Set WshShell = CreateObject("WScript.Shell")
AccessPath = WshShell.RegRead("HKEY_CLASSES_ROOT\Access.MDBFile\shell\Open\command\")
AccessPath = Left(AccessPath, InStr(AccessPath, "MSACCESS.EXE") + 12)
WScript.Echo "Launching Access and Opening temp database file: " & vbCrLf & LocalFile
WshShell.Run AccessPath & " """ & LocalFile & """", 1, True
WScript.Echo "Copying temp database file back to Dropbox folder..."
fso.CopyFile LocalFile, DropBoxInUse
Set f = fso.GetFile(DropBoxInUse)
f.Name = FileNameWhenAvailable
Set f = Nothing
' Make another copy of the file that was copied to the dropbox folder, then delete the original file
' (This might help stop a bad catastrophe!)
WScript.Echo "In Temp Folder: Copying temp database file to be .oldfile"
fso.CopyFile LocalFile, OldLocalFile
WScript.Echo "In Temp Folder: Deleting temp database file "
fso.DeleteFile LocalFile
End If
Set fso = Nothing
End Sub
' Do the work!
OpenDatabase

I know this is an old question, I do not think it is possible to do this safely. The issue is that LDB files, which are the files that manages the share of connections to the database can lose track of open state. This occurs when external files are joined to the primary database via JOIN/IN type constructs. When this occurs the Jet/ADO engine still has locks on files even if the application exits, as the file specified in the IN clauses is opened but not closed when the query completes. Then DropBox creates conflicted copies of files and data is lost.

Related

Save a query as text tab delimited but include ".ail2" in the saved name. (ACCESS)

I want to export a query as a text file from an access database but using vba. The issue is I need to save it with .ail2 in the name.
basically I want it of the form: "currentdate_version.ail2".txt (the quotations are very important otherwise it won't work).
So for example todays first version would look like:
"20182910_1.ail2".txt
I have tried exporting it manually and saving it as this but the export wizard doesn't seem to like the quotation marks in the saved name. I have therefore been exporting it (using a custom saved export that i've labelled test1 - it includes the headers of each column, sets the text qualifier as 'none', the field delimiter as 'tab' and file format is 'delimited').
I am using the following code in access, the first part just makes sure the folder with the current date exists.
Private Sub ExportExcel()
Dim myQueryName As String
Dim myExportFileName As String
Dim strSheets As String
Dim sFolderPath As String
Dim filename As Variant
Dim i As Integer
strSheets = Format(Date, "yyyymmdd")
sFolderPath = "M:\AIL2Files\" & strSheets & ""
Dim fdObj As Object
Set fdObj = CreateObject("Scripting.FileSystemObject")
If fdObj.FolderExists("" & sFolderPath & "") Then
Else
fdObj.CreateFolder ("" & sFolderPath & "")
End If
i = 1
filename = Dir(sFolderPath & "\*" & i & ".txt")
Do While Len(filename) > 0
filename = Dir(sFolderPath & "\*" & i & ".txt")
i = i + 1
Loop
myQueryName = "001_querytest"
myExportFileName = "" & sFolderPath & "\" & Chr(34) & "" & strSheets & "_" & i & ".ail2" & Chr(34) & ".txt"
DoCmd.TransferText acExportDelim, "test1", myQueryName, myExportFileName, True
End Sub
test1 isn't being picked up even though its a 'saved export'. I assume I'm doing this part wrong... but even still I reckon the save won't be successful and will not include the quotation marks.
Thanks.
EDIT:
I have tried doing the following instead:
DoCmd.TransferText transferType:=acExportDelim, TableName:=myQueryName, filename:=myExportFileName, hasfieldnames:=True
It now saves, but again not including the quotation marks as desired. Whats interesting is when I type ?myExportFileName in the immediate window, it displays my desired filename but the command is clearly not working correctly as I get it of the form:
_20181029_1#ail2_
Instead...
Here is image if I use save as:
I end up getting:
There are some misconceptions here.
Windows file names cannot contain double quotes ", period. And you don't need them, either. Just save your file as filename.ail2.
This is what you get when doing "Save as". Tell Explorer to show file extensions, and you'll see that you don't have "filename.ail2".txt but filename.ail2.
You only need
myExportFileName = sFolderPath & "\" & strSheets & "_" & i & ".ail2"
test1 isn't being picked up even though its a 'saved export'.
DoCmd.TransferText doesn't use saved exports, but export specifications. See here for the difference:
Can I programmatically get at all Import/Export Specs in MS Access 2010?
Addendum
DoCmd.TransferText could throw a runtime error when given an illegal file name, but apparently it tries to save the day by exchanging the illegal characters by _, hence _20181029_1#ail2_ (.txt)
A workaround to this is first saving the file as a .txt using DoCmd.TransferText, but running a shell and renaming. Like such:
myExportFileName = sFolderPath & "\" & strSheets & "_" & i & ".txt"
DoCmd.TransferText TransferType:=acExportDelim, SpecificationName:="034_AILFILE Export Specification", TableName:=myQueryName, filename:=myExportFileName, HasFieldnames:=True
Set wshShell = CreateObject("Wscript.Shell")
strDocuments = wshShell.SpecialFolders("M:\AIL2Files\" & strSheets & "")
oldFileName = myExportFileName
newFileName = sFolderPath & "\" & strSheets & "_" & i & ".ail2"
Name oldFileName As newFileName
There is undoubtedly cleaner ways of doing this but I imagine that this method could be used to save any files that have non traditional extensions, but fundamentally follow the format of a .txt file.

Automatic backup on Opening database

Can anyone give me the code to create a backup/copy of the Database when opening? it I know how to use autoexec macro i just need the code. The database name is Datenbank and the back to have the time of back in its name
That command could be:
FileCopy CurrentDb.Name, Replace(CurrentDb.Name, ".accdb", Format(Now(), " yyyymmdd hhnnss") & ".accdb")
but you can't do that for the database file itself from inside the application.
Your best option would be to create a shortcut that runs a script that copies the file first, then opens it.
Addendum
I located a function that will create a zipped backup of the current project:
Option Compare Database
Option Explicit
' API call for sleep function.
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Function ZipCurrentProject() As Long
Dim ShellApplication As Object
Dim CurrentProjectFile As String
Dim ZipPath As String
Dim ZipName As String
Dim ZipFile As String
Dim FileNumber As Integer
' File and folder names.
CurrentProjectFile = CurrentProject.Path & "\" & CurrentProject.Name
' The path must exist.
ZipPath = CurrentProject.Path & "\#dbase_bk" & Format(Now, " yyyy-mm-dd hh.nn.ss") & "\"
ZipName = "CCOLearningHub.zip"
ZipFile = ZipPath & ZipName
' Create sub folder if missing.
If Dir(ZipPath, vbDirectory) = "" Then
MkDir ZipPath
End If
' Create empty zip folder.
FileNumber = FreeFile
Open ZipFile For Output As #FileNumber
Print #FileNumber, Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, vbNullChar)
Close #FileNumber
Set ShellApplication = CreateObject("Shell.Application")
' Copy the project file into the zip file.
With ShellApplication
Debug.Print Timer, "zipping started ..."
.Namespace(CVar(ZipFile)).CopyHere CVar(CurrentProjectFile)
' Ignore error while looking up the zipped file before is has been added.
On Error Resume Next
' Wait for the file to created.
Do Until .Namespace(CVar(ZipFile)).Items.Count = 1
' Wait a little ...
'DoEvents
Sleep 100
Debug.Print " .";
Loop
Debug.Print
' Resume normal error handling.
On Error GoTo 0
Debug.Print Timer, "zipping finished."
End With
Set ShellApplication = Nothing
ZipCurrentProject = Err.Number
End Function

Error in HTA with fileopen

I'm using a script from Rob van der Woude for the open file dialog (top post from here) which is apparently supposed to work in HTA but I get an error saying:
"ActiveX component can't create object: 'UserAccounts.CommonDialog'"
This function may be helps you !
BrowseForFile.vbs
'**************************************************************************************
' GetFileDlg() And GetFileDlgBar() by omen999 - may 2014 - http://omen999.developpez.com
' Universal Browse for files function
' compatibility : all versions windows and IE - supports start folder, filters and title
' note : the global size of the parameters cannot exceed 191 chars for GetFileDlg and 227 chars for GetFileDlgBar
'**************************************************************************************
Function GetFileDlg(sIniDir,sFilter,sTitle)
GetFileDlg=CreateObject("WScript.Shell").Exec("mshta.exe ""about:<object id=d classid=clsid:3050f4e1-98b5-11cf-bb82-00aa00bdce0b></object><script>moveTo(0,-9999);function window.onload(){var p=/[^\0]*/;new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).Write(p.exec(d.object.openfiledlg('" & sIniDir & "',null,'" & sFilter & "','" & sTitle & "')));close();}</script><hta:application showintaskbar=no />""").StdOut.ReadAll
End Function
Function GetFileDlgBar(sIniDir,sFilter,sTitle)
GetFileDlgBar=CreateObject("WScript.Shell").Exec("mshta.exe ""about:<object id=d classid=clsid:3050f4e1-98b5-11cf-bb82-00aa00bdce0b></object><script>moveTo(0,-9999);function window.onload(){var p=/[^\0]*/;new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).Write(p.exec(d.object.openfiledlg('" & sIniDir & "',null,'" & sFilter & "','" & sTitle & "')));close();}</script>""").StdOut.ReadAll
End Function
' sample test
sIniDir = "C:\Windows\Fonts\*"
sFilter = "All files (*.*)|*.*|Microsoft Word (*.doc;*.docx)|*.doc;*.docx|Adobe pdf (*.pdf)|*.pdf|"
sTitle = "GetFileDlg by omen999 2014 - omen999.developpez.com"
' (sIniDir + sFilter + sTitle) size doesn't exceed 191 chars (227 for GetFileDlgBar)
' MsgBox Len(Replace(sIniDir,"\","\\")) + Len(sFilter) + Len(sTitle)
' sIniDir must be conformed to the javascript syntax
rep = GetFileDlg(Replace(sIniDir,"\","\\"),sFilter,sTitle)
MsgBox rep & vbcrlf & Len(rep)
As #JosefZ mentioned in the comments, the UserAccounts.CommonDialog library is available in Windows XP only. However, there are other ways to display an "Open File" dialog.
The Shell.Application object has a BrowserForFolder() function that, by default, displays a dialog asking you to select a folder. However, you can configure this dialog in a number of ways by using combinations of the ulFlags values. For example, if you include the BIF_BROWSEINCLUDEFILES flag, the dialog will also show files in addition to folders.
Here's a minimal example showing how you can have the BrowserForFolder dialog to display files and prompt the user to select a file:
' BROWSEINFO Flags...
Const BIF_NONEWFOLDERBUTTON = &H0200 ' Hide the [New Folder] button
Const BIF_BROWSEINCLUDEFILES = &H4000 ' Show files in addition to folders
' ShellSpecialFolderConstants...
Const ssfDESKTOP = 0
Dim objStartIn, objFile
With CreateObject("Shell.Application")
' Specify the folder the dialog should start in...
Set objStartIn = .NameSpace(ssfDESKTOP) ' Start in a special folder
Set objStartIn = .NameSpace("c:\") ' Or, start in custom path
' Args = (parent window, dialog title, flags, start folder)
Set objFile = .BrowseForFolder(0, "Select a file:", _
BIF_BROWSEINCLUDEFILES Or BIF_NONEWFOLDERBUTTON, objStartIn)
End With
If Not objFile Is Nothing Then
WScript.Echo objFile.Self.Path
End If
Of course, the user could still select a folder. There's no way to stop that from happening. But you can check the item returned to see if it's a folder and prompt them to reselect (perhaps in a loop).
If objFile.Self.IsFolder Then
' Invalid
End If

ODBC call failed error when an access table is opened

I have linked the sql server tables to ms access so that I can use ms access as the front end.I was able to access the tables from access, until I run into an error ODBC call failed when I tried to open one of the tables. There was no problem with the other tables. Actually I have changed a column name in sql server after creating a link. Is this the problem? I am really worried about this as I was about to use access as a front-end for my future purposes.
When you link to a remote table, Access stores metadata about that table. When you later change the table structure, the metadata doesn't get updated to capture the change.
Delete the link. Then recreate the link. That way the metadata will be consistent with the current version of the table.
Yes changing the column name after linking the table is most likely causing your failure. Is it is now trying to pull data from a column that no longer exists. You will need to relink the table. You can programatically link tables in access. We do that in may of our access applications and drive the tables that need to be linked from a local access table.
Public Sub LinkODBCTables()
Dim objRS As DAO.Recordset
Dim objTblDef As DAO.TableDef
Dim strTableName As String
Dim strAliasName As String
Dim strDSN As String
Dim lngTblCount As Long
Set objRS = CurrentDb.OpenRecordset( _
" select TableName," & _
" AliasName," & _
" DSN," & _
" DatabaseName," & _
" Development_DSN," & _
" UniqueIndexCol" & _
" from tblODBCLinkedTables " & _
" order by TableName", dbOpenSnapshot)
While Not objRS.EOF
' Check to see if we already have this linked tableDef
' We don't care if it is not actually in there
strTableName = objRS.Fields("TableName")
If Not IsNull(objRS.Fields("AliasName")) Then
strAliasName = objRS.Fields("AliasName")
Else
strAliasName = strTableName
End If
If DEV_MODE Then
strDSN = objRS.Fields("Development_DSN")
Else
strDSN = objRS.Fields("DSN")
End If
On Error Resume Next
CurrentDb.TableDefs.Delete strAliasName
If Err.Number <> 0 And _
Err.Number <> 3265 Then ' item not found in collection
Dim objError As Error
MsgBox "Unable to delete table " & strAliasName
MsgBox Err.Description
For Each objError In DBEngine.Errors
MsgBox objError.Description
Next
End If
On Error GoTo 0
Set objTblDef = CurrentDb.CreateTableDef(strAliasName)
objTblDef.Connect = g_strSQLServerConn & _
"DSN=" & strDSN & _
";DATABASE=" & objRS.Fields("DatabaseName") & _
";UID=" & g_strSQLServerUid & _
";PWD=" & g_strSQLServerPwd
objTblDef.SourceTableName = strTableName
On Error Resume Next
CurrentDb.TableDefs.Append objTblDef
If Err.Number <> 0 Then
Dim objErr As DAO.Error
For Each objErr In DBEngine.Errors
MsgBox objErr.Description
Next
End If
On Error GoTo 0
' Attempt to create a uniqe index of the link for updates
' if specified
If Not IsNull(objRS.Fields("UniqueIndexCol")) Then
' Execute DDL to create the new index
CurrentDb.Execute " Create Unique Index uk_" & strAliasName & _
" on " & strAliasName & "(" & objRS.Fields("UniqueIndexCol") & ")"
End If
objRS.MoveNext
Wend
objRS.Close
End Sub
We are using a single SQLServer login for our access applications so the g_strSQLServerUID and g_strSQLServerPwd are globals that contain that info. You may need to tweek that for your own needs or integrated security. We are setting up two DSNs one for production and the other for development. The DEV_MODE global controls wich set of DSNs are linked. You can call this code from a startup macro or startup form. It will deleted the old link and create a new link so you always have the most up to date schema.

Import data from web site in MS Access

I want to write an import function for importing data from a website into a ms access database. The original data is stored in a mysql database and is available via a remote text file (csv). So all I want is to access this remote file and read it in vba. The code I use is below, but it seems that references are missing. Don't know which reference ActiveXperts.Http needs. Could anybody help?
Thx
Steve
Dim objHttp
Dim strUrl
Dim strData
' Create a HTTP instance
Set objHttp = CreateObject("ActiveXperts.Http")
' Write some information to console
MsgBox "ActiveSocket " & objHttp.Version & " demo."
MsgBox "Expiration date: " & objHttp.ExpirationDate & vbCrLf
Do
strUrl = InputBox("Enter a URL", "Input", "www.activexperts.com/products")
Loop Until strUrl <> ""
objHttp.LogFile = "C:\HttpLog.txt"
objHttp.Connect (strUrl)
If (objHttp.LastError <> 0) Then
MsgBox "Error " & objHttp.LastError & ": " & objHttp.GetErrorDescription(objHttp.LastError)
Else
strData = objHttp.ReadData
If (objHttp.LastError <> 0) Then
MsgBox "Error " & objHttp.LastError & ": " & objHttp.GetErrorDescription(objHttp.LastError)
Else
MsgBox strData
End If
objHttp.Disconnect
MsgBox "Disconnect."
End If
MsgBox "Ready."
This tutorial says that it needs ActiveSocket 2.4 Type Library.
(the tutorial is for VB 5/6 and not VBA, but the reference stuff should be exactly the same)