I am working on version controlling my MS Access databases by creating an Add-in which contains VBA modules to export my database to ASCII text files, and import those to a database. I am using a combo of approaches which are discussed here:
Version Control with Access Development
and here:
Export Access objects to text
The above links do not really provide solutions for tables. So far I have been able to export the data from the tables into .csv files which contain the data. I then export each table's field information (name,type,attributes,description,size) etc. into a text file which I can later read in (when I do the import) to create tables with those fields set properly. I also had to export the Primary key information (from the indexes) so I can properly set the primary keys.
I am now struggling to export/import relations. To export relations, I use the following code:
Private Sub ExportRelationships()
Dim relationsFolder As String
Dim relat As Relation
Dim field As field
Dim newRelationName As String
relationsFolder = CreateSubFolder("relations")
Open relationsFolder & "relations.txt" For Output As #1
' Loop over each relationship and write to relations.txt file
For Each relat In db.Relations
For Each field In relat.Fields
newRelationName = relat.Table & "_" & field.Name & "__" & relat.ForeignTable & "_" & field.ForeignName
Write #1, newRelationName; relat.Table; relat.ForeignTable; relat.Attributes; field.Name; field.ForeignName
Next field
Next relat
Close #1
End Sub
This creates a .csv text file which contains the information I need to recreate the relations.
I then try to import the relations.txt file created using the following code:
Private Sub ImportRelationships()
Dim fileName As String
Dim currentLine As String
Dim relat As Relation
Dim db As Database
Dim items() As String
Set db = CurrentDb()
fileName = exportFolder & "relations\relations.txt"
Open fileName For Input As #1
While Not EOF(1)
Line Input #1, currentLine
items = Split(currentLine, ",")
If CLng(items(3)) <> 4356 Then
Set relat = db.CreateRelation(Replace(items(0), Chr(34), ""), Replace(items(1), Chr(34), ""), Replace(items(2), Chr(34), ""), CLng(items(3)))
relat.Fields.Append relat.CreateField(Replace(items(4), Chr(34), ""))
relat.Fields(Replace(items(4), Chr(34), "")).ForeignName = Replace(items(5), Chr(34), "")
db.Relations.Append relat
End If
Wend
End Sub
But when I run this, I get a Run-time '3001' Invalid argument error.
I feel like I am missing something critical which is required to create relations. Perhaps it has something to do with the Indexes of a table? Could someone please help me out and explain what I would need to do to export the relations and import them properly?
Thanks in advance for your help.
Related
I am running Access 2016. I am trying to export the results of a query into a text file, I keep on getting an error 3625 no spec is found. I created the spec and if I run the spec it works as expected. I tried putting quotes instead of the export spec, but there was no formatting on the file. The solutions I found on the web were saying to use the advanced tab to define formatting, On my version of Access 2016 there is no advanced tab in the spec creation process. I have stepped through the process and all the directories and the file name is created properly.
The error occurs on the line :
DoCmd.TransferText TransferType:=acExportDelim, SpecificationName:=strExportSpec, TableName:=strQueryName, FileName:=strFullName, HasFieldNames:=True
Any help is appreciated.
Private Sub Export_Click()
Dim strFileName As String
Dim lFileName As Long
Dim strCurrentDate As String
Dim strFormattedDate As String
Dim dtCurrentDate As Date
Dim strDir As String
Dim strFullName As String
Dim strExportSpec As String
Dim strQueryName As String
Dim strYear As String
Dim strMonth As String
Dim strPath1 As String
Dim strPath2 As String
strYear = Format(Date, "yyyy")
strMonth = Format(Date, "mm")
'Check if Directory Year exists
strPath1 = "C:\Users\Owner\Google Drive\Employment\Mass Unemployment\" & strYear
'Check if year exists
If Dir(strPath1, vbDirectory) = "" Then
MkDir strPath1
End If
'Create
strPath2 = "C:\Users\Owner\Google Drive\Employment\Mass Unemployment\" & strYear & "\" & strMonth & "\"
If Dir(strPath2, vbDirectory) = "" Then
MkDir strPath2
End If
strCurrentDate = Date
strFormattedDate = Format(strCurrentDate, "mmddyyyy")
lFileName = InputBox("Enter Week Number", "Enter Week Number")
strFileName = strFormattedDate
strFullName = strPath2 & strFileName & ".txt"
strExportSpec = "Export_Spec" ' error 3625 export spec does not exist
strQueryName = "qryUnEmployment"
DoCmd.TransferText TransferType:=acExportDelim, SpecificationName:=strExportSpec, TableName:=strQueryName, FileName:=strFullName, HasFieldNames:=True
End Sub
I believe what Parfait is telling you is that the Saved Import/Saved Exports are far different than an Import/Export Specification. You are trying to put a Saved Export into the TransferText parameter where a Specification is called for. You likely did an export at some point and saved the steps as a Saved Export.
If you're truly interested in using a specification for this export then you will want to create one by walking through the import of an already existing text file in the format you would like. See Parfait answer above.
Otherwise, just leave the specification parameter blank and the query will be exported.
The Save Import/Export GUI frontend feature and the backend method, DoCmd.TransferText refer to different specification types. The former is more a saved routine as a convenience method to retrieve the same named text, spreadsheet, or XML file and all the steps to import or export the external data and avoid the walk through of wizard in future runs.
However, the latter is specific to formatting of any text file and it is usually created during the text file wizard under Advanced button. See screenshot below. In this dialog you can specify formats for each field, delimiters, etc. and then either run the specification one time or Save As... for future uses on any text file. In fact, Specs... shows a current list of all saved named specifications. It is here where you can find the name to use in DoCmd.TransferText.
Import Text Wizard
Export Text Wizard
To date, there may not be any other GUI way to adjust these saved specifications. They are stored in system tables, MSysIMEXspecs and MSysIMEXColumns. Again, do not confuse above text file specific method for the generalized external data methods: ImportExportSpecifications and DoCmd.RunSavedImportExport.
I have an MS SQL Database from a customer with an Access Application.
This application stores files within this MS SQL database.
I tried to just get the bytes from the database and just save them to the disk.
With some of the files this works and with some it does not.
(images don't work, zips work, wordfiles are to open but word has to recover them)
I found out that Access saves the files within an OLE Object.
So i need to get out the Original Files from the OLE Object!
It seems that this is quite difficult.
I tried to find a .NET library which can seperate the files from the OLE Object.. found nothing...
Now i am trying to get the files out with Access...
It seems that i neet a getChunk Function to do that...
Found this page with a WriteBlob Code... it is said that it would to what i need..
https://support.microsoft.com/en-us/help/210486/acc2000-reading--storing--and-writing-binary-large-objects-blobs
Now i can write Files to the Harddisc... but the files are still not able to open!
Something's wrong here...
My complete VBA Code is this:
Option Compare Database
Const BlockSize = 32768
Sub xxx()
Dim id As Integer
Debug.Print "****************************************************"
Debug.Print "****************************************************"
Debug.Print "****************************************************"
Debug.Print "****************************************************"
Dim unnoetig As Variant
Dim dok() As Byte
Dim sql As String
sql = "select top 1 idCaseDetail, idCase, Dokument from dbo_law_tbl_CaseHistory where idCaseDetail = ""1"""
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset(sql)
If Not rst.EOF Then
Do While Not rst.EOF
Debug.Print "idcasehistory: " & rst.Fields(0)
Debug.Print "idcase: " & rst.Fields(1)
If Not IsNull(rst.Fields(2).Value) Then
dok = rst.Fields(2)
unnoetig = WriteBLOB(rst, "Dokument", "c:\temp\ole.doc")
End If
rst.MoveNext
Loop
End If
End Sub
'**************************************************************
' FUNCTION: WriteBLOB()
'
' PURPOSE:
' Writes BLOB information stored in the specified table and field
' to the specified disk file.
'
' PREREQUISITES:
' The specified table with the OLE object field containing the
' binary data must be opened in Visual Basic code and the correct
' record navigated to prior to calling the WriteBLOB() function.
'
' ARGUMENTS:
' T - The table object containing the binary information.
' sField - The OLE object field in table T containing the
' binary information to write.
' Destination - The path and filename to write the binary
' information to.
'
' RETURN:
' The number of bytes written to the destination file.
'**************************************************************
Function WriteBLOB(T As DAO.Recordset, sField As String, _
Destination As String)
Dim NumBlocks As Integer, DestFile As Integer, i As Integer
Dim FileLength As Long, LeftOver As Long
Dim FileData As String
Dim RetVal As Variant
On Error GoTo Err_WriteBLOB
' Get the size of the field.
FileLength = T(sField).FieldSize()
If FileLength = 0 Then
WriteBLOB = 0
Exit Function
End If
' Calculate number of blocks to write and leftover bytes.
NumBlocks = FileLength \ BlockSize
LeftOver = FileLength Mod BlockSize
' Remove any existing destination file.
DestFile = FreeFile
Open Destination For Output As DestFile
Close DestFile
' Open the destination file.
Open Destination For Binary As DestFile
' SysCmd is used to manipulate the status bar meter.
RetVal = SysCmd(acSysCmdInitMeter, _
"Writing BLOB", FileLength / 1000)
' Write the leftover data to the output file.
FileData = T(sField).GetChunk(0, LeftOver)
Put DestFile, , FileData
' Update the status bar meter.
RetVal = SysCmd(acSysCmdUpdateMeter, LeftOver / 1000)
' Write the remaining blocks of data to the output file.
For i = 1 To NumBlocks
' Reads a chunk and writes it to output file.
FileData = T(sField).GetChunk((i - 1) * BlockSize _
+ LeftOver, BlockSize)
Put DestFile, , FileData
RetVal = SysCmd(acSysCmdUpdateMeter, _
((i - 1) * BlockSize + LeftOver) / 1000)
Next i
' Terminates function
RetVal = SysCmd(acSysCmdRemoveMeter)
Close DestFile
WriteBLOB = FileLength
Exit Function
Err_WriteBLOB:
WriteBLOB = -Err
Exit Function
End Function
Do you have any suggestions?
Important to say is:
It is an MS SQL Database... not an Access Database.. there are some tools which maybe could word with access-Databases.. but not mit ms sql
Is there a .NET way or an VBA way to save the files to disc?
An easy alternative to using DAO for saving OLE objects, is to use the ADODB.Stream object:
Public Sub SaveOLEObject(OleObjectField As Field, Filelocation As String)
Dim adoStream As Object 'ADODB.Stream
Set adoStream = CreateObject("ADODB.Stream")
adoStream.Type = 1 'adTypeBinary
adoStream.Open
adoStream.Write OleObjectField.Value
adoStream.SaveToFile Filelocation, adSaveCreateOverWrite
adoStream.Close
End Sub
Call it:
SaveOLEObject(rst.Fields("Dokument"), "c:\temp\ole.doc")
Note that, of course, your documents might just be corrupt, and that might explain the problem.
If your objects are stored in SQL Server, I'd prefer directly opening an ADO recordset containing the binary data from SQL server over creating a linked table and opening a DAO recordset from the linked table.
In Access, create a corresponding Access Form with all relevant fields. Use the VBA code provided in the link and you should be able to export some of the most common file types in an automated fashion. Good luck.
https://medium.com/#haggenso/export-ole-fields-in-microsoft-access-c67d535c958d
I need to create several text files in vb.net based on values entered in a spreadsheet. Each text file will be named 'valuename.txt'.
I populate an array with the value names as they are entered:
issues(j) = Grid1.Cells(1, j).Value
Now I need to open text files with their names. I would like to do something along the lines of:
Dim Filename As String = "C:\" & Grid1.Cells(1, j).Value & ".txt"
Dim issues(j) As New System.IO.StreamWriter(Filename)
When I enter this in Visual Studio, it says it does not like:
issues(j)
Do I have any other options?
It seems like the code you have posted is inside a for loop with j being the counting variable.
You are already building a filename from the cell values, so just declare the streamwriter as a new variable and use it:
For j = 0 To Grid1.Rows.Count - 1 'Assumed by me
'Create the filename for the current row
Dim Filename As String = "C:\" & Grid1.Cells(1, j).Value & ".txt"
'The Using block makes sure that the ressources used by the streamwriter are disposed again.
'It is equivalent as Dim sw As New IO.Streamwriter, but Using should be preferred
Using sw As New IO.StreamWriter(Filename)
'Use the streamwriter to write the data
End Using
'If you additionally want to store the values in an array for whatever reason
issues(j) = Grid1.Cells(1, j).Value
Next
Your Dim issues(j) statement does not make any sense.
To append data to an existing file, use the overload of the StreamWriter constructor:
Using sw As New IO.StreamWriter(Filename, True)
The second parameter defines if data should be added to the file.
You can use Using to declare a new StreamWriter:
Dim Filename As String = "C:\" & Grid1.Cells(1, j).Value & ".txt"
Using fsw As New System.IO.StreamWriter(Filename)
'Do Something
End Using
But if you insist to use a list of StreamWriter (I don't know why) then you can do something like this:
Dim fsw As New List(Of System.IO.StreamWriter)
fsw(j) = New System.IO.StreamWriter(Filename)
'Do Something
fsw(j).Close
fsw(j).Dispose
I have a visual basic program that creates files that are necessary for a semiweekly process. These files are a .bas file (for qbasic) and a .lot file (for voxco automation). I can live without the .bas file and simply put it's functionality directly into my program. I do, however, need the .lot file. Normally these files are copied from old files and edited manually. This is, as you can imagine, tedious. However, the files created by my program do not run properly through any means I have of running them. When I compare the manually created files to the automatically created files, the differences are minimal to nonexistent. The encoding doesn't seem to be an issue either. I simply don't know why the files created by my program are not running properly when the files created manually are working fine.
Here is the code that creates the .lot file:
Dim LotText As String
LotText = *removed*
Dim QuLines As String = Nothing
Dim Reader As New StreamReader(LotFilePath & OldStudy & ".LOT")
Dim SLine As String = Nothing
While Not Reader.EndOfStream
SLine = Reader.ReadLine()
If SLine.StartsWith("*QU") Then
QuLines = QuLines & SLine & vbCrLf
End If
End While
LotText = LotText & QuLines
Dim TempPath As String
TempPath = LotFilePath & "BackEnd\" & StudyID & ".LOT"
My.Computer.FileSystem.WriteAllText(TempPath, LotText, 0)
When you say the differences are minimal - what are they exactly!? A single character at the beginning of the file could be making the whole thing fail.
I have had problems in the past with writing vbCrLf to files in this manner; try the following code instead to see if it offers any improvement.
Dim LotText As String = *removed*
' Create a list of strings for the output data
Dim QuLines As New Collections.Generic.List(Of String)
Dim Reader As New StreamReader(Path.Combine(LotFilePath, OldStudy & ".LOT"))
Dim SLine As String = Nothing
While Not Reader.EndOfStream
SLine = Reader.ReadLine()
If SLine.StartsWith("*QU") Then
' This line is desired; add it to our output list
QuLines.Add(SLine)
End If
End While
' Concatenate the existing data and the output; uses the system defined NewLine
LotText &= Environment.NewLine & String.Join(Environment.Newline, QuLines)
Dim TempPath As String = Path.Combine(LotFilePath, "BackEnd", StudyID & ".LOT")
My.Computer.FileSystem.WriteAllText(TempPath, LotText, 0)
I've started to run into some concurrency issues with my databases. I have roughly ten different aacdb files in a shared location on our office network. One of these databases is kind of the 'master' database. It is split into backend and front end. The backend of this databases holds common tables such as users/passwords, employees, departments, etc etc.
Yesterday, I made two databases purely for input. They each have a single form bound to a table in 'data entry' mode, with record locks set to 'edited record.' They also link to some of the same tables shared by other databases. This is where I started to run into (likely?) concurrency issues for the first time.
People have been reporting odd behavior (forms not opening, etc) in the 'master' database. This was tested a bit and only happens when users are also in the linked data-entry only databases.
There are still less than ten current users across all of the databases at a given time.
Would drop down selections hold a lock on a table, preventing certain forms from opening?
AFAIK, dropdowns are just queried when the form is loaded.
Any ideas?
I had fits with this issue, trying to have several users share the same front end from a network share. Things would just...not work. Then when I went back it was impossible to dupilcate the failures. I decided to have the application installed on the local machines, but this had version control issues, especially since I had several different front ends running at the same time for different projects. There were updaters out there but they either cost money or I couldnt see the code and didnt trust them. I came up with this as a solution and have been using it since Access 2003.
This is a seperate ACCESS database, you have to lock it down just like you would any front end.
This launcher works for the four access front ends that I am running right now. There are two table that you have to setup on the network.
TABLE NAME: RunTimeTracking
FIELD: RTTID : AutoNumber
FIELD: RTTComputerName : Text
FIELD: RTTLoginTime : Date/Time
TABLE NAME: VersionControlTable
FIELD: VCTID : AutoNumber
FIELD: VCTVersion : Number
FIELD: VCTSourceLoc : Text
FIELD: VCTDest : Text
FIELD: VCTDateVer : Date/Time
The RunTimeTracking table works to prevent the user from starting the actual application without using the launcher. When the launcher runs it inserts a entry into the table with the computer name. When the application runs it looks for that entry, if it doesnt see it. It warns and dumps.
In the version control table put the location of the most up to date app, the location on the local machine where you want the applicaiton to be stored.
If you have more than one program that you are controlling, then increment VCTVersion entry and reference it in your code in the launcher.
strSQL = "SELECT * FROM VersionControlTable WHERE VCTVersion = 200"
When the launcher runs it checks the CREATED datestamp on the local file to the one on the network, if they are different, it copies. If not, it runs.
Private Sub Form_Load()
DoCmd.ShowToolbar "Ribbon", acToolbarNo
DoCmd.ShowToolbar "Status Bar", acToolbarNo
DoCmd.Maximize
Form.TimerInterval = 2000
End Sub
Private Sub Form_Timer()
runDataCheck
End Sub
Private Sub runDataCheck()
' This is the launcher program. This program is designed to check for
' Version information and upload and download the new version automaticaly.
' Place entry into the Run Time Tracking Table. This will be used by the Main Application to verify that
' The application was launched by the Launcher and not run straight from the desktop
'First, retrieve the name of the computer from the Environment.
Dim strCompName As String
strCompName = Environ("computername")
' Now, delete all entries on the tracking table that have this computer name associated with it.
' Later we will try to add a trigger that archives the logins.
Dim strSQL As String
strSQL = "DELETE FROM RunTimeTracking WHERE RTTComputerName = '" & strCompName & "'"
adoSQLexec (strSQL)
' Now, add and entry into the table
strSQL = "INSERT INTO RunTimeTracking (RTTComputerName,RTTLoginTime) VALUES ('" & strCompName & "','" & Now() & "')"
adoSQLexec (strSQL)
' First, retrieve the parameters from the Version Control File and put them into variables that we can use.
Dim strSource As String
Dim strDest As String
Dim dateVer As Date
Dim rs As New ADODB.Recordset
'LBLSplashLabel.Caption = "Checking Version Information...."
strSQL = "SELECT * FROM VersionControlTable WHERE VCTVersion = 200"
With rs
rs.Open strSQL, CurrentProject.Connection
End With
strSource = rs.Fields("VCTSourceLoc").Value
strDest = rs.Fields("VCTDest").Value
dateVer = rs.Fields("VCTDateVer").Value
Set rs = Nothing
' Next. See if the folders on both the local drive and the source drive exists.
Dim binLocal As Boolean
Dim binNet As Boolean
Dim binDirectoryLocal As Boolean
'Debug.Print strSource
' First check to see if the network file exists.
binNet = FileExists(strSource)
If binNet = False Then
MsgBox ("The network source files are missing. Please contact Maintenance!")
Application.Quit (acQuitSaveNone)
End If
' Get the timestamp from the network version since it exists.
Dim fileNet As File
Dim fileLocal As File
Dim fileNetObject As New FileSystemObject
Set fileNet = fileNetObject.GetFile(strSource)
Debug.Print strSource
Debug.Print "Created Date : " & fileNet.DateCreated
Dim strDirName As String
Dim intFind As Integer
' Check to see if the Local file Exists.
binLocal = FileExists(strDest)
If binLocal = False Then
'There is no local file. Check to see if the directory exists
' Get the directory name
intFind = (InStrRev(strDest, "\", , vbTextCompare))
strDirName = (Left(strDest, intFind - 1))
Debug.Print "Directory Name: " & strDirName
binDirectoryLocal = FolderExists(strDirName)
If binDirectoryLocal = False Then
'There is no local directory. Create one
MkDir (strDirName)
' LBLSplashLabel.Caption = "Copying Files...."
'Copy the source file to the directory.
FileCopy strSource, strDest
'Since we have no copied the latest version over, no need to continue. Open the main app
OpenMaintApp (strDest)
Else
' No need to create the directory, simply copy the file.
'Copy the source file to the directory.
' LBLSplashLabel.Caption = "Copying Files...."
FileCopy strSource, strDest
'Since we have no copied the latest version over, no need to continue. Open the main app
OpenMaintApp (strDest)
End If
End If
'Now we know that the file is in the directory, now we need to check its version.
'Get the last modified date from the file.
Set fileLocal = fileNetObject.GetFile(strDest)
Debug.Print "Last Modified Date : " & fileLocal.DateCreated
'Do the version check
If fileLocal.DateCreated <> fileNet.DateCreated Then
' LBLSplashLabel.Caption = "Copying Files...."
'Copy the source file to the directory.
FileCopy strSource, strDest
'Since we have no copied the latest version over, no need to continue. Open the main app
OpenMaintApp (strDest)
Else
OpenMaintApp (strDest)
End If
OpenMaintApp (strDest)
End Sub
Private Sub OpenMaintApp(strAppName As String)
Dim accapp As Access.Application
Set accapp = New Access.Application
accapp.OpenCurrentDatabase (strAppName)
accapp.Visible = True
DoCmd.Quit acQuitSaveNone
End Sub