Access VBA how to read a txt file from an attachment field - vba

I wrote an R function, which is too long to be stored even in a memo field. There is probably a way of reading it if I store it in a txt file somewhere in my hard drive. But can I save this txt file in an attachment field and read it with vb code? So far the nearest answer I got is as below to print names of the attachment, but not what is in the attachment.
Dim dbs As DAO.Database
Dim rst As DAO.Recordset2
Dim rsA As DAO.Recordset2
Dim fld As DAO.Field2
'Get the database, recordset, and attachment field
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tblAttachments")
Set fld = rst("Attachments")
'Navigate through the table
Do While Not rst.EOF
'Print the first and last name
Debug.Print rst("FirstName") & " " & rst("LastName")
'Get the recordset for the Attachments field
Set rsA = fld.Value
'Print all attachments in the field
Do While Not rsA.EOF
Debug.Print , rsA("FileType"), rsA("FileName")
'Next attachment
rsA.MoveNext
Loop
'Next record
rst.MoveNext
Loop

I never store files in attachment fields. Instead I will store the absolute path to the file in the table and then use VBA to display or modify the file.
You can use the following code to print the contents of a text file to the console. NOTE: You will need to add the Microsoft Scripting Runtime reference to your project.
Dim fso As FileSystemObject
Dim ts As TextStream
Set fso = CreateObject("Scripting.FileSystemObject")
' use path stored in table vvv here
Set ts = fso.OpenTextFile(path, ForReading, False, 0)
Do While ts.AtEndOfStream <> True
debug.print ts.ReadLine
Loop
ts.Close

Related

Automated Attachment Import Module -- [Error: "Run-time error '424': Object required"]

This is my first time actually posting in a forum so let me know if I am using any bad practice here.
I am using access to organize iMessage data to format into a human-readable book. The database contains timestamp and attachment filename fields. The actual attachment file names contain said timestamp and filename values with some filler between. My goal is to parse through several thousand texts and import all attachments where applicable. See example below.
Database Example: https://i.stack.imgur.com/6rcgi.png
File Example: https://i.stack.imgur.com/0xvjy.png
I have the module written out as seen below and am getting "Error: "Run-time error '424': Object required" referencing line 27. Very helpful, Microsoft.
Option Compare Database
Function ImportAttach()
Dim db As DAO.Database
Dim rs As DAO.Recordset2
Dim rsT As DAO.Recordset2
Dim rsA As DAO.Recordset2
Dim fldT As DAO.Field2
Dim fldA As DAO.Field2
Dim strTimeStamp As String
Dim strFileName As String
Dim strPath As String
Dim strFile As String
Set db = CurrentDb
Set rs = db.OpenRecordset("iMessageDB")
Set fldT = rs("TimeStamp")
Set fldA = rs("Attachment")
strFilePath = "C:\Users\XPS\Documents\Projects\iMessage Book\attachments\"
rs.MoveFirst
Do Until rs.EOF
Set rsT = fldT.Value '<-- Error Here
Set rsA = fldA.Value
If IsNull(strFileName) Then
rs.MoveNext
Else
strFile = Dir(strPath & strTimeStamp & "*" & strFileName)
rs.Edit
rsA.AddNew
rsA("FileData").LoadFromFile strPathFileName
rsA.Update
End If
strFile = Dir
rsA.Close
rs.Update
rs.MoveNext
Loop
rs.Close
db.Close
Set fldT = Nothing
Set fldA = Nothing
Set rsT = Nothing
Set rsA = Nothing
Set rs = Nothing
Set db = Nothing
End Function
I have not found a good solution elsewhere, so I appreciate any help.

MSAccess VBA - Loop only through user-selected records

I'm trying to iterate through the records of a database, in order to save all of the attachments associated to certain fields of each record. I managed to find a way to properly export the attachments by cycling though the entire table. However, it would be way more useful to export only the attachments of the records previously selected by the user in the table form.
This is what my code structure looks like at the moment:
Public Function Main()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset2
Dim rsA As DAO.Recordset2
Dim CRT As DAO.Field2
Dim cat As DAO.Field2
Dim prg As DAO.Field2
Dim strFullPath As String
Dim CatPrg As String
Dim fso As New FileSystemObject
'Get the database, recordset, and attachment field
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("Archieve_Table")
Set STF = rst("STF")
Set cat = rst("CAT")
Set prg = rst("PRG")
'Navigate through the table
Do While Not rst.EOF
CatPrg = cat.Value & "-" & prg.Value
'Get the recordset for the Attachments field STF
Set rsA = STF.Value
'Save all attachments in the field
Do While Not rsA.EOF
strPath = CurrentProject.Path & "\Export\" & CatPrg & "\STF\"
strFullPath = strPath & rsA("FileName")
'Make sure the file does not exist and save
If Dir(strFullPath) = "" Then
rsA("FileData").SaveToFile strFullPath
End If
'Next attachment
rsA.MoveNext
Loop
rsA.Close
'Next record
rst.MoveNext
Loop
rst.Close
dbs.Close
Set STF = Nothing
Set rsA = Nothing
Set rst = Nothing
Set dbs = Nothing
Set cat = Nothing
Set prg = Nothing
End Function
Probably I need to add some conditions at Set rst = dbs.OpenRecordset("Archieve_Table") when I set the OpenRecordset.

Move Files to New Directory based on SQL Query Data

Hoping someone could help:)
I have an MS Access table that holds file names along with other data Example:
AcctNum, FileName
12345, abc123.pdf
I have written a SQL to sort the file name based on account number. Example: Select * from tblTest where AcctNum='12345'
Files with these file names are located in a directory (C:\Test\<filename>.pdf)
I need to move the selected files based on the SQL I've written to move those files to a different directory (D:\Test\FromCode). Filename 'abc123.pdf' is located in C:\Test move to D:\test, loop through SQL results to move files based on criteria.
Attached is some VBA that I have written that I can get a file to copy from source to destination manually when I input the exact filename (as seen in the code, the file name is "abc123"), but I want to tie it to the mysql query recordset and move the group which will contain 1000's of files. Anyone know the best way I can tie this to recordset?
Appreciate any direction/help you provide.
Sub UpdateDirectory()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim rs As DAO.Recordset
Dim db As DAO.Database
Dim mysource As String
Dim mydes As String
Dim mysql As String
mysql = "SELECT * from tblTest where ACCTNUM = 123456"
mysource = "C:\Test"
mydes = "D:\Test\FromCode\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(mysource)
Set db = CurrentDb
Set rs = db.OpenRecordSet(mysql)
'I want to tie mysql recordset to below to move all files/records based
'on ACCTNUM. This could result in moving 1000's of files to
'destination.
For Each objFile In objFolder.Files
If InStr(1, objFile.Name, "abc123") > 0 Then
Debug.Print "yes"
objFSO.CopyFile objFile, mydes
Else
Debug.Print "no"
End If
Next
'clean
Set objFolder = Nothing
Set objFile = Nothing
Set objFSO = Nothing
End Sub
Here is your code with a working answer: To be sure, #June7 is correct, but putting the answer in your context:
Sub UpdateDirectory()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim rs As DAO.Recordset
Dim db As DAO.Database
Dim mysource As String
Dim mydes As String
Dim mysql As String
mysql = "SELECT * from tblTest where ACCTNUM = 123456"
mysource = "C:\Test" 'Missing backslash - added later
mydes = "D:\Test\FromCode\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(mysource)
Set db = CurrentDb
Set rs = db.OpenRecordSet(mysql)
'I want to tie mysql recordset to below to move all files/records based
'on ACCTNUM. This could result in moving 1000's of files to
'destination.
While Not rs.EOF
sourceFile = mysource & "\" & rs!Filename 'Added a missing backslash
destFile = mydes & rs!Filename
If Dir(sourceFile) <> "" Then 'If sourceFile exists, then Dir(sourceFile) will return it's name, otherwise empty string
FileCopy sourceFile, destFile
End If
rs.MoveNext
Wend
End Sub
That SQL is not sorting records, it is filtering.
The recordset serves no purpose if you do not loop through records. If you do not want to simply copy all files and the complete account number is not part of filename, then need to loop through recordset, not folder. Use filename from field in the file copy. FSO is not needed - Access FileCopy method can serve.
...
mysource = "C:\Test\"
...
Do While Not rs.EOF
If Dir(mysource & rs!Filename) <> "" Then FileCopy mysource & rs!Filename, mydes & rs!Filename
Loop

How do I save all the attachments in a single field for all records in a MS Access table?

I am working with a Microsoft Access 2010 database.
I have a number of pictures saved as attachments in one field of a table.
How do I save all the pictures to a local folder for all records simultaneously?
I need to preserve the names of the attachments but they can all go in the same folder.
Thank you :-)
Use below sub to save all attachment file for all records.
Private Sub cmdLoadPicture_Click()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset2
Dim rsA As DAO.Recordset2
Dim fld As DAO.Field2
Dim savePath As String
savePath = "C:\Users\Harun.Rashid\Pictures\Screenshots\" 'Folder path to save files
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tblEmpInfo") 'tblEmpInfo is table name
Set fld = rst("EmpPhoto") 'EmpPhoto is Field name to table with attachment data type.
Do While Not rst.EOF 'Loop through all records of table.
Set rsA = fld.Value
On Error Resume Next 'Omit errors if file already exist
Do While Not rsA.EOF 'Loop through all attachment of single record
rsA.Fields("FileData").SaveToFile savePath 'Save file to disk
rsA.MoveNext
Loop
rst.MoveNext
Loop
rst.Close
dbs.Close
Set fld = Nothing
Set rst = Nothing
Set dbs = Nothing
End Sub

How to copy a pre-existing Word document when a new folder is created?

I have a macro to create a folder for each e-mail containing attachments and store it's attachments.
I would like an existing Word document to be copied to every new folder created.
I tried fileCopy, but I can't make it work since the target is variable.
Option Explicit
Sub Application_Startup()
Dim ol As Outlook.Application
Dim ns As Outlook.Namespace
Dim fol As Outlook.Folder
Dim i As Object
Dim mi As Outlook.MailItem
Dim at As Outlook.Attachment
Dim rootfol As Outlook.Folder
Dim fso As Scripting.FileSystemObject
Dim dir As Scripting.Folder
Dim dirName As String
Set fso = New Scripting.FileSystemObject
Set ol = New Outlook.Application
Set ns = ol.GetNamespace("MAPI")
Set rootfol = ns.Folders(1)
Set fol = rootfol.Folders("boîte de réception").Folders("test")
For Each i In fol.Items
If i.Class = olMail Then
Set mi = i
If mi.Attachments.Count > 0 Then
dirName = "C:\Users\chadi\OneDrive\Documents\VBA\" & Format(mi.ReceivedTime, "yyyy-mm-dd hh-nn-ss ") & Left(Replace(mi.Subject, ":", ""), 20)
If fso.FolderExists(dirName) Then
Set dir = fso.GetFolder(dirName)
Else
Set dir = fso.CreateFolder(dirName)
End If
For Each at In mi.Attachments
at.SaveAsFile dir.Path & "\" & at.Filename
Next at
End If
End If
Next i
End Sub
Maybe someone else can give you a better answer without needing more information but I need you to be more specific about the variability of this file because I cannot answer your question with VBA code.
I also do not see FileCopy anywhere in your example.
[ EDIT ]
I commented out the file selection and added new code that should work with the new information you provided.
[ IMPORTANT ] I assume you are using Windows. You need to Shift Right Click on your Word document and select Copy As Path. Then you need to paste the path in the new code to completely replace [paste the path here] If you do it correctly it should look something like like mySpecialWordDocument = "C:\MyDirectory\MyFiles\MyFile.docx"
If fso.FolderExists(dirName) Then
Set dir = fso.GetFolder(dirName)
Else
Set dir = fso.CreateFolder(dirName)
'With Application.FileDialog(msoFileDialogFilePicker)
'.AllowMultiSelect = False
'.Filters.Clear
'If .Show Then fso.CopyFile .SelectedItems(1), dirName & "\" & Split(.SelectedItems(1), "\")(UBound(Split(.SelectedItems(1), "\")))
'End With
Dim mySpecialWordDocument as String
mySpecialWordDocument= [paste the path here]
fso.CopyFile mySpecialWordDocument, dirName & "\" & Split(mySpecialWordDocument, "\")(UBound(Split(mySpecialWordDocument, "\")))
End If
It opens a dialog window for the user to select a file and copies that file into the new folder.
For me to answer the question you asked, you need to tell me how you manually decide which file to select.