thanks guy's been so busy sorting other peoples problems out that i will have to come back to this but thanks to you all, will have a look
thanks guy's been so busy sorting other peoples problems out that i will have to come back to this but thanks to you all, will have a look
That's the one I was thinking about. I remember that I translated the Spanish or Portuguese to English.There was a vba example by Emilio Sancha a few years back.
https://www.utteraccess.com/topics/2035296
If this helped, please click the star * at the bottom left and add to my reputation- Thanks
here's an example with Emilio's code in english. This will do multiple images at once.
Select a folder of images, select the images to resize in the multiselect listbox, set the height and width, click Resize.
If this helped, please click the star * at the bottom left and add to my reputation- Thanks
Excellent, thank you moke123 and all who have taken the time to advise, will take a look as i am sure i can make adjustments (folder paths etc) once i read the code
Hi Moke123, i have copied over modules into my modules, is there a reference i need to select from library ? I have checked Microsoft windows Image Acquisition v 2.0
I am getting Sub or Function Not Defined (GetLBX)
This is what i copied over
StrPix = Split(getLBX(Me.lstImages, 1), ",")
Code:Option Compare DatabaseOption Explicit Dim dict As New Scripting.Dictionary Public Function getLBX(lbx As ListBox, Optional intColumn As Variant = 0, Optional Seperator As String = ",", _ Optional delim As Variant = Null) As String 'Iterates thru the multiselect listbox and constructs an array of the selected items 'Arguments: 'Lbx is Listbox Object ie.Me.MyListbox 'intColumn is the column # to be returned 'Seperator is the character seperating items in array returned 'Delim is optional delimiter to be return in array ie. #1/1/2001#,#12/25/2015# Dim strlist As String Dim varSelected As Variant 'On Error GoTo getLBX_Error If lbx.ItemsSelected.Count = 0 Then 'MsgBox "Nothing selected" Else For Each varSelected In lbx.ItemsSelected If Nz(lbx.Column(intColumn, (varSelected)), "") <> "" Then strlist = strlist & delim & lbx.Column(intColumn, (varSelected)) & delim & Seperator Else strlist = strlist End If Next varSelected If Nz(strlist, "") <> "" Then strlist = Left$(strlist, Len(strlist) - 1) 'remove trailing comma End If End If getLBX = strlist On Error GoTo 0 Exit Function getLBX_Error: MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure getLBX of Module modLBX" End Function
This is My sub commandm the GetLBX is returning Sub Or Function Not Defined, I am going to be removing fBrowse eventually because all of the images come from DriveSelect And Path
Code:Dim srcPath As String, AccPath As String, CustPath As String, CustName As String, Dest As String, imgPath As String, srcFile As String, OldName As StringDim i As Integer, imgQty As Integer, iRec As Integer, ImgNo As Integer Dim DriveSelect As String, CamFile As String, strStoreFile As String, strTempFile As String, strDealer As String, strPC As String, strFld As String Dim rs As DAO.Recordset, rs2 As DAO.Recordset Dim ImgDate As Date Me.txtFolder = fBrowse(msoFileDialogFolderPicker) FillList DriveSelect = Forms!frmMainMenu!cboDrive srcPath = DriveSelect & "\DCIM\101MSDCF\" Me.txtFolder = srcPath Dim fol As Folder Dim fil As file Dim fso As New FileSystemObject Set fol = fso.GetFolder(Me.txtFolder) For Each fil In fol.Files Me.lstImages.AddItem fil.Name & ";" & fil.Path Next Me.intWidth = "200" Me.intHeight = "440" 'CamFile = Dir(srcPath & "DSC*.*") 'ImgDate = Format(Now(), "dd-mm-yy") 'strDealer = Me.cboDealerIndex7.Column(0) 'strPC = Me.cboDealerIndex7.Column(1) Dim StrPix As Variant StrPix = Split(getLBX(Me.lstImages, 1), ",") For i = 0 To UBound(StrPix) ReSize CStr(StrPix(i)), Me.intHeight, Me.intWidth Next i
Where does this come from?
Dim dict As New Scripting.Dictionary
It is not in that DB?
Please use # icon on toolbar when posting code snippets.
Cross Posting: https://www.excelguru.ca/content.php?184
Debugging Access: https://www.youtube.com/results?sear...bug+access+vba
Hi WGM, no i have removed that now, just going through piece by piece
I noticed 1 schoolboy error, i didn't select the list to Value List but still didn't get it to work, then realised that I needed the file names in the list then select them, i think that should make it work but:
Now getting fol = nothing from the FillList
I think once i get the file names in the list then multiselect, it will work
Code:Private Sub FillList() Dim fol As Folder Dim fil As file Dim fso As New FileSystemObject Set fol = fso.GetFolder(Me.txtFolder) For Each fil In fol.Files Me.lstImages.AddItem fil.Name & ";" & fil.Path Next End Sub
Getting Runtime error13 type mismatch on the Set fol line
Fixed that one, not used fBrowse, used the following
Code:'Me.txtFolder = fBrowse(msoFileDialogFolderPicker) 'FillList Me.txtFolder = Forms!frmMainMenu!cboDrive & "\DCIM\101MSDCF\" Dim Filename As String Filename = Dir(Me.txtFolder & "*.jpg", vbNormal) Do While Len(Filename) > 0 Me.lstImages.AddItem Filename Filename = Dir() Loop
The argument for fso.GetFolder(Me.txtFolder) needs to be a string with the path to the folder.Code:Set fol = fso.GetFolder(Me.txtFolder)
I used me.txtFolder which is a textbox on the form with the path.
If you were to hardcode the path it would look something like
Code:set fol = fso.GetFolder("C:\Dave\MyPictures")
If this helped, please click the star * at the bottom left and add to my reputation- Thanks
The only thing now not happening is Sub Of Function Not Defined as in post 22
GetLBX
StrPix = Split(getLBX(Me.lstImages, 1), ",")StrPix = Split(getLBX(Me.lstImages, 1), ",")
Note that I usedFixed that one, not used fBrowse, used the following
Code:'Me.txtFolder = fBrowse(msoFileDialogFolderPicker) 'FillList Me.txtFolder = Forms!frmMainMenu!cboDrive & "\DCIM\101MSDCF\" Dim Filename As String Filename = Dir(Me.txtFolder & "*.jpg", vbNormal) Do While Len(Filename) > 0 Me.lstImages.AddItem Filename Filename = Dir() Loop
That is using 2 columns in the listbox. the first with the filename and the 2nd with the path.Code:Me.lstImages.AddItem fil.Name & ";" & fil.Path
In getLbx the argument "1" is returning the 2nd column which contains the pathCode:StrPix = Split(getLBX(Me.lstImages, 1), ",")
If this helped, please click the star * at the bottom left and add to my reputation- Thanks
I added that line in, and the db still worked for me.Hi WGM, no i have removed that now, just going through piece by piece
I noticed 1 schoolboy error, i didn't select the list to Value List but still didn't get it to work, then realised that I needed the file names in the list then select them, i think that should make it work but:
Now getting fol = nothing from the FillList
I think once i get the file names in the list then multiselect, it will work
Code:Private Sub FillList() Dim fol As Folder Dim fil As file Dim fso As New FileSystemObject Set fol = fso.GetFolder(Me.txtFolder) For Each fil In fol.Files Me.lstImages.AddItem fil.Name & ";" & fil.Path Next End Sub
Please use # icon on toolbar when posting code snippets.
Cross Posting: https://www.excelguru.ca/content.php?184
Debugging Access: https://www.youtube.com/results?sear...bug+access+vba