I had an access form that displays photo of the users. When I click on the photo area, it also gives me to select the photo. Yesterday, I've upgraded my access from 2010 to 2016. I am using Microsoft Office 2016 plus. Now, the photos are not shown. It gives me to select the photos, but they're not displayed. The codes that I use is below.
Private Sub Photo_Click()
pl = PLFirst()
If IsNull(pl) Then
MsgBox "First select the person.", vbExclamation, "My sample project"
Exit Sub
End If
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.InitialFileName = GetValue("ScanFolder") & ""
fd.Title = "Select Photo"
fd.Filters.Clear
fd.Filters.Add "JPG or JPEG Images", "*.jpg; *.jpeg"
fd.show
If fd.SelectedItems.Count > 0 Then
If PhotoAddress & "" = "" Then
PhotoAddress = GetValue("PhotoAddress")
End If
FileCopy fd.SelectedItems(1), PhotoAddress & "\" & PeopleList.Column(1) & ".jpg"
End If
Set fd = Nothing
UpdatePicture
End Sub
I don't know it's something about the codes or compatibility issue. Any help will be appreciated.
Look at this post:
Apparently Microsoft will fix the problem but as a workaround you can set the Current Database, Picture Property Storage Format to “Preserve source image format”.
Related
I have an Access database with linked tables. I have created a code to do the following:
1- Create a folder in a specific location with a specific name (name populated from data in access).
2- Open a word document saved in a specific path
3- I then use formfields in the document to populate the word document with data from the table
4- Lastly, I save the word document to the previously created folder with a new name using data from the table
I have been using this code successfully for well over a year with no issues.
Suddenly, for no apparent reason and without any change to the code it stopped populating the word document with data. note, its still doing steps 1,2, & 4 but not step 3.
I cannot figure out what the issue is and any help would be much appreciated.
Below is a sample of the code used:
Sub Onboarding_Documents_Saudi_Click()
'STEP ONE: create the appropriate Folder
Dim fs, cf, strFolder
On Error Resume Next
strFolder = "C:\Users\1161\OneDrive - Anfas Medical Care\Master - Anfas Medical Care\New Employees\" & Me.Name_In_English & " " & Me.Emp_Id
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FolderExists(strFolder) = True Then
MsgBox "'" & strFolder & "' already exists!"
Else
Set cf = fs.CreateFolder(strFolder)
If fs.FolderExists(strFolder) = True Then
MsgBox "'" & strFolder & "' successfully created!"
Else
MsgBox "'" & strFolder & "' was not successfully created!"
End If
End If
'STEP TWO:Make Contract .
Dim appWord As Word.Application
Dim doc As Word.Document
Dim Base As String
Base = Format(Me.base_salary, "Standard")
Dim Housing As String
Housing = Format(Me.housing_allowence, "Standard")
Dim Trans As String
Trans = Format(Me.transportation_allowence, "Standard")
On Error Resume Next
Err.Clear
Set appWord = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set appWord = New Word.Application
End If
Set doc = appWord.Documents.Open("C:\Users\1161\OneDrive - Anfas Medical Care\Master - Anfas Medical Care\Forms\Onboarding Documents\Access\Saudi\ContractSaudiAccess.docx", , True)
With doc
.FormFields("frnameinarabic").Result = Me.Name_In_Arabic
.FormFields("frnameinenglish").Result = Me.Name_In_English
.FormFields("frid").Result = Me.Document_ID_number
.FormFields("frmobile").Result = Me.mobile_number
.FormFields("frjtenglish").Result = Me.Job_title_English
.FormFields("frjtarabic").Result = Me.Job_Title_Arabic
.FormFields("frbasesalary").Result = Base
.FormFields("frhousing").Result = Housing
.FormFields("frtrans").Result = Trans
.FormFields("fremail").Result = Me.Personal_Email
.FormFields("empid").Result = Me.Emp_Id
.FormFields("joindate").Result = Me.Join_Date
.FormFields("joindatehijri").Result = Me.[Join Date Hijri]
.FormFields("contractperiod").Result = Me.[Contract Length]
.FormFields("contractperiodar").Result = Me.[Contract Length Ar]
.FormFields("frdepartment").Result = Me.Department
.FormFields("frdepartmentarabic").Result = Me.Department_Ar
.FormFields("joindate1").Result = Format(Me.Join_Date, "dddd dd/mmm/yyyy", vbUseSystemDayOfWeek)
.Activate
.Visible = True
.Activate
End With
doc.Fields.Update
doc.SaveAs2 "C:\Users\1161\OneDrive - Anfas Medical Care\Master - Anfas Medical Care\New Employees\" & Me.Name_In_English & " " & Me.Emp_Id & "\" & FileName & "Contract " & Me.Name_In_English & " " & Me.Emp_Id & ".docx"
Set doc = Nothing
Set appWord = Nothing```
Could this be a change due to Office Updates? I have something similar which works with Word v1910 (Build 12130.20272) but not in v2301 (Build 16026.20146). That may explain the second machine suddenly not working also?
It appears opening the "template" document which you are then adding information into opens read only as requested but now no longer allows changes to be made, which is where I think your code is skipping too? Our running code displays the Word document after filling in the form fields and there is no option to change the file mode to the top right of the screen to allow editing.
Screen shot of viewing / editing options from Word toolbar
I don't have an answer as to how to fix it as yet, I'm afraid, apart from making the template document open for write access and changing rights on the network to make the documents read only. We've not tested that as yet though. Hopefully it helps by giving you something else to check as the code has run successfully for a time and suddenly stopped.
I'm currently trying to find an option for opening a file as read only but allowing changes to the open document but am struggling to find anything like this in the Microsoft documentation. If I do find a solution I'll come back and post it.
It may work for you changing the following line from True to False at the end if the file is somewhere not shared.
Set doc = appWord.Documents.Open("C:\Users\1161\OneDrive - Anfas Medical Care\Master - Anfas Medical Care\Forms\Onboarding Documents\Access\Saudi\ContractSaudiAccess.docx", , True)
I created a Word (2022) mailmerge document. Later I changed the .docx to a .docm so I could do some post-mailmerge processing on the generated output. Now I'd like to use VBA to allow selection of the source data file, but I wasn't able to make that work.
Then I found [https://stackoverflow.com/questions/61547489/automated-word-vba-mailmerge], which described exactly what I'm looking to perform in VBA. In my mailmerge document VBA I now have:
Private Sub Document_Open()
' Application.ScreenUpdating = False
Dim StrMMSrc As String
With Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
.Title = "Data Source Selector"
.AllowMultiSelect = False
.Filters.Add "Documents", "*.xls; *.xlsx; *.xlsm", 1
.InitialFileName = ""
If .Show = -1 Then
StrMMSrc = .SelectedItems(1)
Else
GoTo ErrExit
End If
End With
With ActiveDocument.MailMerge
.OpenDataSource Name:=StrMMSrc, ReadOnly:=True, AddToRecentFiles:=False, _
LinkToSource:=False, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;" & _
"Data Source=StrMMSrc;Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
SQLStatement:="SELECT * FROM 'Students'"
End With
ErrExit:
Application.ScreenUpdating = True
When I open the merge document I can step through the Document_Open code in VBA. The FileDialog works correctly, showing me the folder C:\Gld\RT\Office Database, and I select file "Database 2022-23.xlsx". Variable StrMMSrc is correctly set to the file I selected, "C:\Gld\RT\Office Database\RT Database 2022-23 Test.xlsx". But then it pops up a window "Select Table" showing no tables. If I drop down Workbook, it shows me 2 old Excel documents and a document named "C:\Gld\RT\Office Database.xls", which doesn't actually exist. Any idea as to why it's confusing the "Office Database" folder with a non-existent "Office Database.xls" document?
Jonsson's comments answer the question accurately.
I don't know what went wrong the other day, but using the syntax
SELECT * FROM [Students$] Order by [Grade] ASC, [Last Name] ASC, [First Name] ASC
worked correctly today.
Thanks so much, Jonsson, for your time and effort in helping me.
I am not a programmer so not sure what to do here. I would like an option of adding an image file in a Microsoft Word document userform for MAC. I had used a code earlier which works perfectly in Windows but it doesnt work for MAC and gives a 5948 error. I had added a field for the image in the userform with a button to add the image and the final submit button. The add button should allow the user to insert any size image from the local folder.
The code I was using is given below:
Dim ImagePath As String
Private Sub CMDAddImage_Click()
Dim objFileDialog As Office.FileDialog
Set objFileDialog = Application.FileDialog(MsoFileDialogType.msoFileDialogFilePicker)
With objFileDialog
.AllowMultiSelect = False
.ButtonName = "File Picker"
.Title = "File Picker"
If (.Show > 0) Then
End If
If (.SelectedItems.Count > 0) Then
Call MsgBox(.SelectedItems(1))
ImagePath = .SelectedItems(1)
End If
End With
Image1.Picture = LoadPicture(ImagePath)
End Sub
And the code in submit button was:
Dim objWord
Dim objDoc
Dim objShapes
Dim objSelection
'Set objSelection = ActiveDocument.Sections
'objSelection.TypeText (vbCrLf & "One Picture will be inserted here....")
ActiveDocument.Bookmarks("Field04").Select
Set objShapes = ActiveDocument.InlineShapes
objShapes.AddPicture (ImagePath)
End
End Sub
Can someone please help me edit the code for mac. In mac it does not allow to add the file.
You should check out the suggestion made by #JohnKorchok in a comment to your previous question - insert an image Content Control in your document instead, and throw away the VBA.
But if you need to keep using VBA and a UserForm...
Application.FileDialog is not available on Mac.
Application.GetOpenFileName is not avaialble from Word (it's an Excel thing).
Application.Dialogs does not do the same thing as GetOpenFileName so the user experience will be rather different, but at its simplest, you can use it like this:
With Application.Dialogs(wdDialogFileOpen)
' .Display = -1 for "OK" ("Open" in this case)
' .Display = 0 for "Cancel"
' (THere are other possible return values
' but I do not think they are applicable here)
If .Display = -1 Then
ImagePath = .Name
End If
End With
or if you prefer, the lengthier
Dim dlg As Word.Dialog
Set dlg = Application.Dialogs(wdDialogFileOpen)
With dlg
If .Display = -1 Then
ImagePath = .Name
End If
End With
Set dlg = Nothing
However, this dilaog does not let you specify file types or any kind of filtering, a starting folder etc. Attempts to set Finder search criteria via something like
.Name = "(_kMDItemFileName = ""*.jpg"")"
.Update
before the .Display either can't work or need different syntax.
Further, the Apple dialog may start with its
own filtering set up so the user will have to click Options to enable All Files. You don't know what file type the user will choose so you will need to deal with that.
An alternative is to invoke Applescript. For this, it appears that you can still use the VBA MacScript command, which means that you can put all the script in your VBA file. If that does not work, then unfortunately you have to use AppleScriptTask which would require you to work some more on the Script and install the script in the correct folder on every Mac where you need this feature.
Here's the code I used - you would probably need to wrap everything up in another function call and use conditional compilation or other tests to call the correct routine depending on whether the code is running on Mac or Windows
Private Sub CMDAddImage_Click()
Dim s As String
Dim sFileName As String
On Error Resume Next
s = ""
' set this to some other location as appropriate
s = s & "set thePictureFoldersPath to (path to pictures folder)" & vbNewLine
s = s & "set applescript's text item delimiters to "",""" & vbNewLine
s = s & "set theFile to ¬" & vbNewLine
' add the image file types you want here
s = s & "(choose file of type {""png"",""jpg""} ¬" & vbNewLine
s = s & "with prompt ""Choose an image to insert."" ¬" & vbNewLine
s = s & "default location alias thePictureFoldersPath ¬" & vbNewLine
s = s & "multiple selections allowed false) as string" & vbNewLine
s = s & "set applescript's text item delimiters to """"" & vbNewLine
' choose file gives as an AFS path name (with colon delimiters)
' get one Word 2016/2019 will work with
s = s & "posix path of theFile"
sFileName = MacScript(s)
If sFileName <> "" Then
' Maybe do some more validation here
ImagePath = sFileName
Image1.Picture = LoadPicture(ImagePath)
End If
End Sub
I am looking to use VBA to update links for an external input file. I am a developer and the path for the linked input file I use will not be the same as the end user will need once it is placed in a production folder.
Is there a way to update the linked file location using VBA? I already have code that allows the user to specify the input file location and that information is saved in the [InputFolder] of the [Defaults] table. Is there a way to use VBA to update the Linked Table using the InputFolder field info?
The stored InputFolder data looks like this:
C:\Users\CXB028\OneDrive - Comerica\Projects\HR\Input Data
The new folder info would have a network drive location path defined that I do not have access to but the user would.
Here is the code I use to define and store the Input Folder location:
Private Sub btnInputFldr_Click()
On Error GoTo Err_Proc
Const msoFileDialogFolderPicker As Long = 4
Dim objfiledialog As Object
Dim otable As DAO.TableDef
Dim strPathFile As String, strFile As String, strpath As String
Dim strTable As String
Dim fldr As Object
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Choose Folder"
.Show
.InitialFileName = "" 'DFirst("InputFolder", "Defaults")
If .SelectedItems.Count = 0 Then
Exit Sub
Else
CurrentDb.Execute "UPDATE Defaults SET InputFolder='" & .SelectedItems(1) & "';"
End If
End With
Me.txtInputFldr.Requery
Exit Sub
Err_Proc:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Process Error"
End Sub
The linked table (an external excel spreadsheet) needs to be re-linked after the database is moved to the production location using VBA code when the new Input Folder is redefined.
I found some very simple and short code the worked great!! Please see below.
On Error Resume Next
'Set new file path location if the TABLE.FIELDNAME location exists
Set tbl = db.TableDefs("ENTER THE LINKED TABLE NAME HERE")
filePath = DLookup("ENTER YOUR LOOKUP TABLE FIELD NAME HERE", "ENTER YOUR LOOKUP TABLE NAME HERE") & "\ENTER YOUR EXCEL SPREADSHEET NAME HERE.XLSX"
tbl.Connect = "Excel 12.0 Xml;HDR=YES;IMEX=2;ACCDB=YES;DATABASE=" & filePath
tbl.RefreshLink
On Error GoTo 0
Hope someone else finds this as useful as I did!
Say you want to have a button that the user can click and save a copy of the current file as a PDF(Documentation):
Application.ActiveDocument.SaveAs2 fileName:="fileName.pdf", FileFormat:=wdFormatPDF
This works fine, the user is presented with a save dialog, selects a location and the file is saved, however a few things are not correct:
The type displayed does not match what was specified in the VBA, how can this be correct? It still saves as type "PDF" without issue, even after showing "DOCX" as the file type in the "Save as Type" drop down. Also the "fileName.pdf" is not placed in the "File Name" box, its as if the dialog box is unaware of the options set in the VBA code(This same issue is also referenced in this post).
UPDATE 1
After taking a second look at my code I now realize that the SaveAs2 Method was not displaying the dialog menu, the correct version of the code(simplified) can be described as:
Dim selected As String: selected = Application.FileDialog(msoFileDialogSaveAs).Show()
Dim filePath As String
If selected <> 0 Then
filePath = Application.FileDialog(msoFileDialogSaveAs).SelectedItems(1)
Application.ActiveDocument.SaveAs2 fileName:=Split(filePath, ".")(0), FileFormat:=wdFormatPDF
End If
So then the real question(I guess) is how do you get "Application.FileDialog" to display the proper type you wish to save in under the "Save as type" drop down, and this has already been answered by #PatricK. Thanks everyone for the help, I apologize for the initial confused nature of this question.
I am surprised for SaveAs2 will bring you a prompt to be honest - Only a new document and .Save will bring you that prompt.
If you want to get something similar to that prompt, you use Application.FileDialog with type msoFileDialogSaveAs.
Use this code below (perhaps as an AddIn suits more):
Option Explicit
Sub MySaveAs()
Dim oPrompt As FileDialog, i As Long, sFilename As String
Set oPrompt = Application.FileDialog(msoFileDialogSaveAs)
With oPrompt
' Find the PDF Filter from Default Filters
For i = 1 To .Filters.Count
'Debug.Print i & " | " & .Filters(i).Description & " | " & .Filters(i).Extensions
' Locate the PDF filter
If InStr(1, .Filters(i).Description, "PDF", vbTextCompare) = 1 Then
.FilterIndex = i
Exit For
End If
Next
' Change the title and button text
.Title = "Saving """ & ActiveDocument.Name & """ to PDF format"
.ButtonName = "Save to PDF"
' Default name
.InitialFileName = ActiveDocument.Name
' Show the Prompt and get Filename
If .Show = -1 Then
sFilename = .SelectedItems(1)
Debug.Print "Final filename: " & sFilename
' Save the file as PDF
ActiveDocument.SaveAs2 sFilename, wdFormatPDF
End If
End With
Set oPrompt = Nothing
End Sub
Screenshot sample: