Set cell value with VBA - ms-access

I scan and save images with Wia using VBA in Microsoft Access.
The filepath to the saved image should be set as the value of the current cell.
I can't figure out how to do this but it seems like an easy task after learning how to use Wia.
Here is my current code that scans a document.
Function scanImage() As String
Dim imagePath As String
Dim folder As String
folder = "C:\Users\username\Pictures\scans\"
Dim tempName, obj
Set obj = CreateObject("Scripting.FileSystemObject")
tempName = obj.GetTempName
Dim filename
filename = Now
filename = Replace(filename, ".", "_")
filename = Replace(filename, " ", "_")
filename = Replace(filename, ":", "_")
imagePath = folder & filename & ".jpg"
Dim dev As Device
Dim wiaDialog As New WIA.CommonDialog
Dim wiaImage As WIA.ImageFile
Set dev = wiaDialog.ShowSelectDevice
Set wiaImage = wiaDialog.ShowAcquireImage
wiaImage.SaveFile (imagePath)
scanImage = imagePath
End Function

As comments have said - there's no cells in Access, and definitely no active cell.
You can add a record to a database using either of the methods below, but how do you plan on extracting that information again?
In Excel you just ask for the data in cell A1 for example, but in a database you generally ask for the data from a field or fields where another field on that same record is equal to some other values (either by supplying the 'other value' directly or by referencing other tables within the database).
So, for example, in your database you'd ask for the file paths of all files scanned on a certain date, or have some kind of description field to identify the file.
This would be written something like:
SELECT FilePath FROM Table2 WHERE DescriptionField = 'MyPhoto'
Anyway, the answer to get that single text string (imagepath) into a new record in a table is:
Sub InsertValueToTable()
Dim imagepath As String
imagepath = "<file path>"
'NB: The table name is 'Table2', the field (column) within the table is called 'FilePath'.
'One way to do it:
'DoCmd.RunSQL "INSERT INTO Table2(FilePath) VALUES ('" & imagepath & "')"
'Another way to do it:
Dim rst As dao.Recordset
Set rst = CurrentDb.OpenRecordset("Table2")
With rst
.AddNew
rst!FilePath = imagepath
.Update
.Close
End With
Set rst = Nothing
End Sub
Note - if you use a Text field in the database you'll be limited to 255 characters.

Related

Changing a linked table file path to OS username in VBA?

I have linked tables in an Access Database. I want to share this database and the associated excel workbooks with other users. I want to program a one-time use macro that the user will use the first time they use the database to relink the linked tables to the new user's local folder.
For example:
The linked table is current pulling the file from:
C:\Users\jane.doe\Desktop\Database Imports\Premier Account List.xlsx
When the new user (let's say their name is John Smith) relinks the table, it needs to read:
C:\Users\john.smith\Desktop\Database Imports\Premier Account List.xlsx
I basically want to change the file path from my OS Username to new user's OS Username. I already have the code to pull the OS Username, but I'm not sure how to code changing the file path. Here is the code to pull the OS UserName:
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Function fOSUserName() As String
' Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If (lngX > 0) Then
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = vbNullString
End If
End Function
I am fairly new to VBA/Access, so if you could be as specific as possible with your answer, that would be great. Thanks in advanced!
The TableDef object has a Connect property that you need to change. It's a Read/Write String. You just need some string manipulation to make it how you want. Note that if they're moving the database file to the same path, you can just pull CurrentProject.Path rather than futzing with username APIs.
Sub ChangeTableLink()
Dim sNewPath As String
Dim lDbaseStart As Long
Dim td As TableDef
Dim sFile As String
Dim db As DAO.Database
'This is what we look for in the Connect string
Const sDBASE As String = "DATABASE="
'Set a variable to CurrentDb and to the table
Set db = CurrentDb
Set td = db.TableDefs("Fuel Pricing")
'Whatever your new path is, set it here
sNewPath = CurrentProject.Path & "\"
'Find where the database piece starts
lDbaseStart = InStr(1, td.Connect, sDBASE)
'As long as you found it
If lDbaseStart > 0 Then
'Separate out the file name
sFile = Dir(Mid(td.Connect, lDbaseStart + Len(sDBASE), Len(td.Connect)))
'Rewrite Connect and refresh it
td.Connect = Left(td.Connect, lDbaseStart - 1) & sDBASE & sNewPath & sFile
td.RefreshLink
End If
End Sub

How to insert RTF from Word Doc into Access Table Field

In my code I open a word document from MS Access and read out a certain section of the document. If I was doing this and would only have to store the plain text, this would be easy enough... but I need to keep all the formatting.
From what I've read on the web, Access 2007 and up can easily store Rich Text Formatt (RTF). I adjusted my Access Table to have the specified field defined as "Memo" and "Rich Text". So the field itself is set up and working properly.
Copying and pasting some data manually gets stored as it should.
My question to which I can't seem to find an answer: How do you do it using Code???
Here is the relevant code snippet for what I have so far:
Set doc = New Word.Application
doc.Visible = True
Set dcmt = doc.Documents.Open(sPathTemplate)
Set sectn = dcmt.Sections(2)
Dim x As String
sAnalystText = sectn.Range.Tables(1).cell(1, 1).Range.FormattedText
rsComments.AddNew
rsComments![ISIN] = "Fake_ISIN"
rsComments![Fund_Selection] = 1
rsComments![Long Comment Exec] = sAnalystText
rsComments.Update
I have tried using both .Text and .FormattedText but neither works.
Any help much appreciated!
Dim rs As New ADODB.Recordset
Dim A() As Byte
Dim myrtf As Variant
Dim doact As Document
Set doact = ActiveDocument
myrtf = Null
ActiveDocument.Range(0, 100).Copy
Dim dc As New Document
dc.Activate
dc.Range(0, 0).PasteAndFormat wdFormatOriginalFormatting
dc.SaveAs2 FileName:="C:\x.rtf", FileFormat:=wdFormatRTF
dc.Close
doact.Activate
Open "C:\x.rtf" For Binary As #1
ReDim A(LOF(1))
While Not (EOF(1))
Get #1, , A(i)
i = i + 1
Wend
Close #1
myrtf = A
conn.Open "Driver={Microsoft Access Driver (*.mdb, *.accdb)};Dbq=C:\test.accdb"
strsql = "Insert into table ( rftfield) values ('" & myrtf & "')"
conn.Execute strsql
conn.Close

need to dynamically insert attachment to an access form from a local system and save the address into a table

Hey i am new to access database.
I am creating a form in which i need to attach a excel file from the local system. I tried to use the attachment control to attach the document. But i am not able to store it into a table. I need to use that excel document for my further processing. I need to get the path from which the data is selected from my local system.
I hard coded the path and i was able to do my operation but now i need to dynamically fetch the data from the location.
thanks in advance
My code for hard coding looks like this
Private Sub Command4_Click()
Dim dbs As DAO.Database
Set dbs = CurrentDb
If (ifTableExists("featuretable") = True) Then
dbs.Execute "Delete * from featuretable"
End If
Dim filepath As String
filepath = "C:\Users\jolly#iese.fhg.de\Desktop\featurevalues.xlsx"**
DoCmd.TransferSpreadsheet acImport, , "featuretable", filepath, True
fmfeaturesubform.Form.Requery
End Sub
"Attach" and "import" are completely different things. i guess you want to import the excel sheet.
one way would be use the Application.FileDialog:
http://msdn.microsoft.com/en-us/library/office/ff196794(v=office.15).aspx
another way would be search your current folder and import matching filenames:
Dim mBaseFolder As String
Dim mFname as string
mBaseFolder = "C:\test\" ' or application.CurrentProject.Path
mFname = Dir(mBaseFolder & "*.xls")
Do While fname <> ""
DoCmd.TransferSpreadsheet acImport, , "featuretable", mFname , True
mFname = dir()
Loop

Saving file with an incremental number using vba MS Access

I am developing a database program and part of the program is the ability fr the user to attach files. These files are then copied to a specified folder and renamed to reflect the ID of the table. However, my question is that I can achieve this but when the user attaches second file for the same ID it throws error for file already exists.
So could anyone put me in the right direction on how to achieve this i.e. If file exits then save second file an incremental number soon.
some code to help to understand what i am trying to achieve:
Dim objFSO
Const OVER_WRITE_FILES = True
Set objFSO = Nothing
Dim FileLocation As String
Dim DestLocation As String
Dim fileName As String
Dim fileNameI As String
Dim iTemp As Integer
Set objFSO = CreateObject("Scripting.FileSystemObject")
FileLocation = Me.lblTempLocation.Caption
DestLocation = "C:\Dev\"
fileName = [TestName].Value
'If the backup folder doesn't exist, create it.
If Not objFSO.FolderExists(DestLocation) Then
objFSO.CreateFolder (DestLocation)
End If
'Copy the file as long as the file can be found
If Not objFSO.FileExists(DestLocation & fileName & ".pdf") Then
objFSO.CopyFile FileLocation, DestLocation & fileName & ".pdf", OVER_WRITE_FILES
Else
objFSO.CopyFile FileLocation, DestLocation & fileNameI & ".pdf", OVER_WRITE_FILES
Do While (fileName) <> vbNullString
fileNameI = fileName & Format$(iTemp, "_00")
iTemp = iTemp + 1
Loop
End If
the above works fine first time but when the file exists and it goes through the loop it throughs a stack overflow error and stops the code.
Use ID key of first table as foreign key relationship to a second tables 'FKeyID' (one to many table). Create an 'AttachID' in the second table and set your VBA to rename the file based on the attachID allowing for multiple attaches per first table ID.
AttachID = second tables unique key
FKeyID = relation with ID from first table.

Using ADO in Access to import CSV data

So I navigated to the following MSDN Resource Page that addresses how to use ADO objects. My problem is that I cannot get it to work.
What I am trying to do is open a CSV file and read it line-by-line, then create SQL INSERT statements to insert the records into an existing Table in Access 2010. I have tried to find an easier method of doing this, but this appears to be my only option. doing this with the included tools, but so far, I haven't had any luck.
The main issue here is that I have CSV files with inconsistent headings. I want to import 5 files into the same table, but each file will be different depending on which fields contained data. Those fields with no data in them were ignored during the extract. This is why I can't use something like DoCmd.TransferText.
So, now I need to create a script that will open the text file, read the headers in the first line and create a SQL INSERT statement dependent on the configuration of that particular file.
I have a feeling that I have a good handle on how to appraoch the issue, but no matter what I try, I can't seem to get things working using ADO.
Could anyone explain how I can achieve this? My sticking point is getting the Access DB to receive information from the CSV files via ADO.
Instead of reading the CSV file line-by-line, then doing something with each line, I think you should open the file as an ADO recordset. And open a DAO recordset for your Access destination table.
You can then iterate through the fields in each row of the ADO recordset and add their values into a new row of the DAO recordset. As long as the destination table includes fields with the same names and compatible data types as the CSV fields, this can be fairly smooth.
Public Sub Addikt()
#If ProjectStatus = "DEV" Then
' needs reference for Microsoft ActiveX Data Objects
Dim cn As ADODB.Connection
Dim fld As ADODB.Field
Dim rs As ADODB.Recordset
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
#Else ' assume PROD
Const adCmdText As Long = 1
Const adLockReadOnly As Long = 1
Const adOpenForwardOnly As Long = 0
Dim cn As Object
Dim fld As Object
Dim rs As Object
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
#End If
Const cstrDestination As String = "tblMaster"
Const cstrFile As String = "temp.csv"
Const cstrFolder As String = "C:\share\Access"
Dim db As DAO.Database
Dim rsDao As DAO.Recordset
Dim strConnectionString As String
Dim strName As String
Dim strSelect As String
strConnectionString = "Provider=" & _
CurrentProject.Connection.Provider & _
";Data Source=" & cstrFolder & Chr(92) & _
";Extended Properties='text;HDR=YES;FMT=Delimited'"
'Debug.Print strConnectionString
cn.Open strConnectionString
strSelect = "SELECT * FROM " & cstrFile
rs.Open strSelect, cn, adOpenForwardOnly, _
adLockReadOnly, adCmdText
Set db = CurrentDb
Set rsDao = db.OpenRecordset(cstrDestination, _
dbOpenTable, dbAppendOnly + dbFailOnError)
Do While Not rs.EOF
rsDao.AddNew
For Each fld In rs.Fields
strName = fld.Name
rsDao.Fields(strName) = rs.Fields(strName).value
Next fld
rsDao.Update
rs.MoveNext
Loop
rsDao.Close
Set rsDao = Nothing
Set db = Nothing
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
This is the Declarations section of the module where I saved that procedure:
Option Compare Database
Option Explicit
#Const ProjectStatus = "DEV" '"DEV" or "PROD"
Change the values for these constants to test it on your system:
Const cstrDestination As String = "tblMaster"
Const cstrFile As String = "temp.csv"
Const cstrFolder As String = "C:\share\Access"
Note the folder name does not include a trailing backslash.
You will want to adapt that procedure to pass the file name as a parameter instead of leaving it as a constant. And, if your CSV files are stored in more than one directory, you will want to pass the folder name as a parameter, too.
Hopefully showing you how to do it for one file will be enough and you can then take it from here to handle all your CSV files. Also consider adding error handling.
I think the previous answer is unnecessarily complicated. All you need to do it send an XMLHTTP request. That fetches the CSV data as a string, which can then be parsed into a table.
I've posted a VBA subroutine that does that in an answer to a similar question. Documentation of where I found the techniques is in the code comments. I've run it in Access 2019, and it works.