With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.
Option Explicit Dim objWia As WIA.CommonDialog Private Sub Form_Load() Dim d As Device Dim itm As Item Dim imgpic As ImageFile Dim lCounter As Long Dim colRemove As Collection Dim bDeleteAfterDownload As Boolean 'instead of this, do a nice check for a checkbox bDeleteAfterDownload = True 'used for me.print 'if autoredraw = false, and you go to the vb debugging session, and restore your 'app, the text is vanished! Me.AutoRedraw = True 'create a ref to the wia commondialog. Set objWia = New WIA.CommonDialog 'this makes sure a camera is selected, and no scanner. 'the true part ALWAYS displays the dialog (normally omitted if only one dev is found) Set d = objWia.ShowSelectDevice(CameraDeviceType, True) 'for this example, the files are downloaded every time to the 'directory "downloaded images" in the project dir 'you could check wether the image exists, before downloading it 'so only the files that don't exist locally are transferred If Dir(App.Path & "\downloaded images\", vbDirectory) = "" Then 'dir doesnt exist, create it MkDir App.Path & "\downloaded images\" Else 'make sure the dir is empty! Dim tmpPath As String tmpPath = Dir(App.Path & "\downloaded images\", vbNormal + vbReadOnly) While Len(tmpPath) > 0 Kill App.Path & "\downloaded images\" & tmpPath tmpPath = Dir() Wend End If Me.Show lCounter = 0 Me.Caption = "Examining file " & lCounter & " of " & d.Items.Count & " please wait..." 'loop trough all (root) items in the camera device For Each itm In d.Items Dim f As Properties Set f = itm.Properties Dim str As String 'optional, display progress bar here 'the total amount of pictures is stored in d.items.count lCounter = lCounter + 1 Me.Caption = "Examining file " & lCounter & " of " & d.Items.Count & " please wait..." 'give vb time to process its messages (else the app appears as not responding) DoEvents 'is the item a file? (could also be a dir or so) If (f.Item("Item Flags") And ImageItemFlag) = ImageItemFlag Then 'for reference: 'f.Item("Full Item Name") -> "0002\Root\IMG_1141" 'f.Item("Item Name") -> "IMG_1141" 'f.Item("Filename extension") -> "JPG" 'check if the file exist locally (create your own function!) 'If f.Item("Item Name") <> "nameoflocalfile" Then If bDeleteAfterDownload = True Then colRemove.Add itm.ItemID End If 'download the file to a temp buffer Set imgpic = itm.Transfer 'store the file name and extension and app.path in a string, 'so you can use it to perform more operations on it str = App.Path & "\downloaded images\" & f.Item("Item Name") & "." & imgpic.FileExtension 'save the file (default format is used, bmp stays bmp, jpg stays jpg 'this is why we switched to version 2.0 of the lib! imgpic.SaveFile str 'you can process the image further here, it is now stored on your pc! '(add it to a list, to an picturebox, or whatever!) 'End If End If Next If bDeleteAfterDownload = True Then Dim n As Long, i As Long For n = colRemove.Count - 1 To 0 Step -1 For i = 1 To d.Items.Count If d.Items(i).ItemID = colRemove.Item(i) Then 'Some Cameras don't support deleting pictures On Error Resume Next d.Items.Remove i If Err.Number <> 0 Then MsgBox Err.Description Err.Clear End If On Error GoTo 0 Exit For End If Next Next End If Me.Caption = "finished, thanks for waiting!" End Sub