I have a situation where I need to loop through a control that has the file names of attachments loaded to a record in MS Access. On the main form, I have the attachment control itself named "Attachments"(where you can manage/add/remove attachments), a bound long text control called "RecordOfChanges", and a subform named SF_AttachmentsList which contains the control that shows the list of file names.
What I am trying to do is to capture the file names in a variable, and at the end of each file name I want to put ": [Note changes to this attachment here. Put 'No Changes' if none. Or delete this line if not applicable.]". Lastly, I want to take that variable and place it in the "RecordOfChanges" text field.
So for example, if the file names where Doc1.docx, Doc2.xlsx and Doc3.pdf, then the RecordOfChanges field should look like:
Doc1.docx: [Note changes to this attachment here. Put 'No Changes' if none. Or delete this line if not applicable.]
Doc2.xlsx: [Note changes to this attachment here. Put 'No Changes' if none. Or delete this line if not applicable.]
Doc3.pdf: [Note changes to this attachment here. Put 'No Changes' if none. Or delete this line if not applicable.]
Here is the code I have tried so far and I get an error
"Run-Time Error 451. property let procedure not defined and property
get procedure did not return an object VBA".
The debugger highlights the line
strFileName = Forms!Attachments!SF_AttachmentList!......
Private Sub BtnEditSOW_Click()
Dim i As Long
Dim varChanges As String
Dim Count As Integer
Dim strFileName As String
'Counting the number of attachements from attachment control to set the number of loops needed
Count = Me.Attachments.AttachmentCount
'loop thourgh all items in attachments.filename control
For i = 0 To Count
'capture the text string of each file name and concatinate instructions to the end of each file name. <<<This line is where I get the error>>>
strFileName = Forms!Attachments!SF_AttachmentsList!FileName(i) & ": [Note changes to this attachment here. Put 'No Changes' if none. Or delete this line if not applicable.]"
'add file name text to variable varChanges
varChanges = varChanges & Chr(13) & Chr(10) & strFileName
Next i
'Put varChanges in the Record Of Changes text box control.
Me.Attachments_RecordOfChanges = varChanges
End Sub
I don't think your approach of looping through attachments control is going to work (I tried). Open a recordset object and loop records. Probably need to first commit record to table.
Private Sub BtnEditSOW_Click()
Dim varChanges As String
Dim rs As DAO.Recordset
Me.Dirty = False 'force record to commit to table
Set rs = CurrentDb.OpenRecordset("SELECT Attachments.FileName FROM table WHERE ID=" & Me.ID)
'loop through all items in recordset
Do While Not rs.EOF
'capture the text string of each file name and concatenate instructions
'to the end of each file name and build varChanges string.
varChanges = varChanges & rs(0) & ": [Note changes to this attachment here. Put 'No Changes' if none. Or delete this line if not applicable.]" & _
Chr(13) & Chr(10)
rs.MoveNext
Loop
'Put varChanges in the Record Of Changes text box control.
Me.Attachments_RecordOfChanges = varChanges
End Sub
Side note: Could use vbCrLf instead Chr(13) & Chr(10).
Related
This is my first post and I am new to MS Access with no coding experience. I have a Access Database with a table call Attachments with field as "Saved Path" & "File Name". Both are Hyperlink data type.
Since there is limit of 2GB under MS Access attachments option, I would like to save a link to the file saved outside of MS Access.
What I am looking for is, when a user click on Saved Path it opens a windows dialogue box and user select the file (already created and saved under a network path) and this link/path including file name gets saved under this column. So when required they can refer back to that record and just click on the like to open that file directly from there. And under File Name field the name of the file is copied and saved.
Private Sub Saved_Path_Click()
Dim f As Object
Dim strFullpath As String
Dim strFolder As String
Dim strFile As String
Dim intPos As Integer
Dim varItem As Variant
Set f = Application.FileDialog(3)
f.AllowMultiSelect = False
strFullpath = BrowseFile
If f.Show Then
intPos = InStrRev(strFullpath, "\")
Me.Saved_Path = "#" & f.SelectedItems(1) & "#"
Application.FollowHyperlink Me.Saved_Path
End If
Set f = Nothing
End Sub
That code is not saving hyperlink string to Hyperlink type field. Access Hyperlink field data is a string composed of 3 parts separated by # character.
display text # file path\name # any reference within the file
Could have only one field (Hyperlink or Text) with full path\filename and use code to split the string when you want path or filename part.
If you use a Hyperlink type field, save full file path name formatted as a hyperlink string so it is a clickable hyperlink to open file.
Me.fieldname = "#" & f.SelectedItems(1) & "#"
Can extract path part from f.SelectedItems(1) and save to its own Hyperlink field if you want.
If you save path parts, without # characters, to separate normal text fields, options:
VBA FollowHyperlink intrinsic function in Click event procedure to open file
or
calculate a clickable hyperlink string in textbox ControlSource (no VBA).
="Click to open folder#" & [Saved_Path] & "#"
="Click to Open file#" & [Saved_Path] & "\" & [File_Name] & "#"
Set textbox IsHyperlink property to Yes so text looks like a link.
I want to generate an automatic footer when I save a new MS Word file, and update the footer if I SaveAs the file.
The code below used to work well with an old Word. With the latest Word it only works if I press F12 on the keyboard. Any help would be greatly appreciated!
Sub FileSaveAs()
Dialogs(wdDialogFileSaveAs).Show
Dim i As Long
Dim ThisPath As String
Dim pName As String
Dim TextInFooter As String
Dim FullName As String
ThisPath = ActiveDocument.Path
pName = ActiveDocument.Name
FullName = ThisPath & "\" & pName
TextInFooter = "This file was saved in: " & FullName & " on the " & Now
For i = 1 To ActiveDocument.Sections.Count
With ActiveDocument.Sections(i)
.Footers(wdHeaderFooterPrimary).Range.Text = TextInFooter
End With
Next
End Sub
As you noticed, the new version triggers the FileSaveAs only on F12. Not sure if this is bug or a feature.
If it is only important that the document shows the information in print or on open - my suggested workaround:
You could avoid the insertion into the footer on save and insert it using fields, the document already has the information you are inserting. You simply need to make it visible. The footer would be then:
This file was saved as { FILENAME \p } the { SAVEDATE \# "dd.MM.yyyy HH:mm:ss"}
Adjust the Date/Time format as needed. You have to force the update of the fields - this is where the auto macros come into it.
Sub AutoOpen()
' set fields to update before printing (if saved as and printed while open)
Options.UpdateFieldsAtPrint = True
' Update all current fields in just opened document
ActiveDocument.Fields.Update
End Sub
Sub AutoClose()
' update fields when closing
ActiveDocument.Fields.Update
End Sub
The only difference would be, that you have the full path including file name and extension there. Additionally, there might be times, when the file is saved but not yet opened/closed/printed and has also not updated the fields.
In theory, you could insert the footer into the document with the AutoOpen macro as well (activedocument.fields.add).
I have written a macro which when a file is created and the little save button is clicked the macro is triggered(as it overrides the default FileSave function). The macro extracts information from a table in my document, converts it to a string then cleanses that string of any carriage returns then uses that as the file name. An if statement then runs checking whether a hidden row in the table has a value of 1 and if not then it will set the value to 1 and save the document at the location specified with the new filename.
All of this works great except when I re-open the file to edit it, as my users will do, and click save again it tries to run everything again, completely ignoring my If statements first statement and will add a carriage return to the start of the filename effectively breaking the save function to SharePoint as it has an invalid character in it. If you then click save again it will seemingly run the macro as normal and save it by actually reading the if statement correctly. Am I doing something wrong here?
Here is the code:
Sub FileSave()
Dim strText As String
Dim strClean As String
Dim strFileName As String
Dim strLocation As String
Dim strSavedName As String
Dim strCleanSave As String
strText = ActiveDocument.Tables(1).Rows(1).Cells(2).Range.Text
strClean = Application.CleanString(strText)
strFileName = strClean + "_" + Format(Date, "yyyy-mm-dd")
strLocation = "[My SharePoint Site]"
If ActiveDocument.Tables(1).Rows(1).Cells(3).Range.Text = "1" Then
strSavedName = ActiveDocument.Name
strCleanSave = Application.CleanString(strSavedName)
ActiveDocument.SaveAs FileName:=strSavedName
Exit Sub
Else
ActiveDocument.Tables(1).Rows(1).Cells(3).Range.Text = "1"
ActiveDocument.SaveAs FileName:=strLocation & strFileName & ".docx"
End If
End Sub
Word table cell text ranges are terminated with two hidden chars, a carriage return (ASCII 13) and a bell (ASCII 7). Your IF condition returns false because it is testing the equivalence of "1" and "1" & Chr(13) & Chr(7).
In your case you can limit the test to the first char:
If Left$(ActiveDocument.Tables(1).Rows(1).Cells(3).Range.Text, 1) = "1" Then
More generally you can test the visible cell contents with a Len() - 2.
Hope that helps.
I am running MS Access 2010. Using VBA I am trying to pull attachments out of MS Exchange 2013 and insert them into the Access table "TBL_APPT_ATTACHMENT".
The table "TBL_APPT_ATTACHMENT" looks like this:
Attachment_title Memo
Attachment_filename Memo
Attachment_blob OLE Object
Everything seems to work correctly except I can not figure out how to save the actual file into the column ATTACHMENT_BLOB. Here is my VBA function that I am calling (See question marks below).
Private Function createRecord(fItem As Outlook.AppointmentItem)
Set rsAtt = CurrentDb.OpenRecordset("TBL_APPT_ATTACHMENT")
rsAtt.OpenRecordset
For Each Attachment In fItem.Attachments
Call MsgBox("FileName: " & Attachment.FileName, vbOKOnly, "Error")
Call MsgBox("DisplayName: " & Attachment.DisplayName, vbOKOnly, "Error")
Call MsgBox("Index: " & Attachment.Index, vbOKOnly, "Error")
rsAtt.AddNew
rsAtt!APPT_ITEM_ID = aID
rsAtt!APPT_FIELD_id = rsOl!ID
rsAtt!ATTACHMENT_TITLE = Attachment.DisplayName
rsAtt!ATTACHMENT_FILENAME = Attachment.FileName
rsAttID = rsAtt!ID
rsAtt.Update
'Save file to harddrive.
filePath = "c:\temp\" + Attachment.FileName
Attachment.SaveAsFile (filePath)
Set rsParent = CurrentDb.OpenRecordset("SELECT ID, ATTACHMENT_BLOB FROM TBL_APPT_ATTACHMENT WHERE ID = " & rsAttID)
rsParent.OpenRecordset
Do While Not rsParent.EOF
rsParent.Edit
'Load file into Database.
'??? This next statement gives me a "Type Mismatch" error. Why?????
Set rsChild = rsParent.Fields("ATTACHMENT_BLOB").Value
rsChild.AddNew
rsChild.Fields("FileData").LoadFromFile (filePath)
rsChild.Update
rsParent.Update
rsParent.MoveNext
Loop
Next
End Function
Thanks!!
Remember that the attachment is really a file (whether its an OLE object or not). While it may be possible to perform a copy-paste of the object from Outlook into Access, my recommendation is to save the attachment as a file:
dim filepath as String
dim filename as String
filepath = "C:\appropriatefolder\"
filename = Attachment.FileName
Attachment.SaveAsFile filepath & filename
Now you're in a position to save the attachment in Access, but I seriously don't recommend using the Attachment field type. It can be rather tricky to use. So my solution to the same problem was to create a field of type Hyperlink. Then your statement in your macro will simply be:
rsAtt!ATTACHMENT_LINK = filename & "#" & filepath & filename
The hyperlink definition is important and uses the format:
displayString # fullPathToFile [ # optionalPositionInsideFile ]
EDIT: Using the Attachment Field Type in Access
The Attachment field type in an Access table can be understood if you consider it an embedded recordset within that single record. Therefore, every time you add a new record (or read an existing record), you have to handle the Attachment field a bit differently. In fact, the .Value of the Attachment field is the recordset itself.
Option Compare Database
Option Explicit
Sub test()
AddAttachment "C:\Temp\DepTree.txt"
End Sub
Sub AddAttachment(filename As String)
Dim tblAppointments As DAO.Recordset
Dim attachmentField As DAO.Recordset
Dim tblField As Field
Set tblAppointments = CurrentDb.OpenRecordset("TBL_APPT_ATTACHMENT", dbOpenDynaset)
tblAppointments.AddNew
tblAppointments![APPT_ITEM_ID] = "new item id"
tblAppointments![APPT_FIELD_ID] = "new field id"
tblAppointments![ATTACHMENT_TITLE] = "new attachment"
tblAppointments![ATTACHMENT_FILENAME] = filename
'--- the attachment field itself is a recordset, because you can add multiple
' attachments to this single record. so connect to the recordset using the
' .Value of the parent record field, then use it like a recordset
Set attachmentField = tblAppointments![ATTACHMENT_BLOB].Value
attachmentField.AddNew
attachmentField.Fields("FileData").LoadFromFile filename
attachmentField.Update
tblAppointments.Update
tblAppointments.Close
Set tblAppointments = Nothing
End Sub
Here is what I ended up doing.
Private Function createRecord(fItem As Outlook.AppointmentItem)
Set rsAtt = CurrentDb.OpenRecordset("TBL_APPT_ATTACHMENT")
rsAtt.OpenRecordset
For Each Attachment In fItem.Attachments
'Save file to harddrive.
filePath = "c:\temp\" + Attachment.FileName
Attachment.SaveAsFile (filePath)
rsAtt.AddNew
rsAtt!APPT_ITEM_ID = aID
rsAtt!APPT_FIELD_id = rsOl!ID
rsAtt!ATTACHMENT_TITLE = Attachment.DisplayName
rsAtt!ATTACHMENT_FILENAME = Attachment.FileName
Call FileToBlob(filePath, rsAtt!ATTACHMENT_BLOB)
rsAttID = rsAtt!ID
rsAtt.Update
Next
End Function
Public Function FileToBlob(strFile As String, ByRef Field As Object)
On Error GoTo FileToBlobError
If Len(Dir(strFile)) > 0 Then
Dim nFileNum As Integer
Dim byteData() As Byte
nFileNum = FreeFile()
Open strFile For Binary Access Read As nFileNum
If LOF(nFileNum) > 0 Then
ReDim byteData(1 To LOF(nFileNum))
Get #nFileNum, , byteData
Field = byteData
End If
Else
MsgBox "Error: File not found", vbCritical, _
"Error reading file in FileToBlob"
End If
FileToBlobExit:
If nFileNum > 0 Then Close nFileNum
Exit Function
FileToBlobError:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, _
"Error reading file in FileToBlob"
Resume FileToBlobExit
End Function
I am not very clued up with VBA and need some help with the following:
I want to create a txt file and save it in a specific location (overwriting the existing file with the same name).
The text file must countain the last word in the email subject, which will be an Account Number. For the purpose of this explanation I'm going to call the account number Variable1.
if the Email Subject = Account Recon - 10201314050019434586
then Variable1 = 10201314050019434586
The text file that must be created/replaced:
C:\Users\tenba1\Documents\QlikView\Account Recons\Recon_Acct.txt
The text in the file must be:
SET vAcct = 'Variable1';
So in this example the text in the file must be:
SET vAcct = '10201314050019434586';
The macro must look at the last word in the subject (i.e. everything after the last space) - an account number is not always 20 digits.
Thanks in advance
This should do the trick. It's a macro script which takes the Subject of the top opened email and writes the Accountnumber into Recon_Acct.txt. If there is no number, the text will be SET vAcct = ''. The File will be overwritten, every time you execute the script.
Sub writeSubjectToFile()
Const FILEPATH = "C:\Users\tenba1\Documents\QlikView\Account Recons\Recon_Acct.txt"
Dim objEmailItem As Object, strSubject
Dim strSubject As String
Dim strText As String
Set objEmailItem = Application.ActiveInspector.CurrentItem
strSubject = objEmailItem.subject
strText = Trim(Right(strSubject, Len(strSubject) - InStr(1, strSubject, "-")))
Open FILEPATH For Output As 1
Print #1, "SET vAcct = '" & strText & "';"
Close #1
End Sub