Hi,
I have below module to save picture under named folder:
To use it, just put below code in an event:
But how to save the picture with customized name, say "Materials 0001.Jpg"
Thanks
I have below module to save picture under named folder:
Code:
Option Compare Database
Public Enum acFileType
acPicture = 1
acFiles = 2
End Enum
Public Function UploadFile(strDestinationPath As String, _
FileType As acFileType, _
Optional bIsUpload As Boolean = True) As String
On Error GoTo ErrorHandler
Dim strSourceFile As String
Dim strDestinationFile As String
Dim strFullFileName As String
Dim FSO As Object
If Right$(strDestinationPath, 1) <> "\" Then
strDestinationPath = strDestinationPath & "\"
End If
Set FSO = CreateObject("Scripting.FileSystemObject")
If Not FSO.FolderExists(strDestinationPath) Then
MsgBox "Folder [" & strDestinationPath & "] can not be found", vbCritical, "Message!"
Set FSO = Nothing
Exit Function
End If
With Application.FileDialog(3)
.title = "Choose File"
.InitialFileName = ""
.Filters.Clear
Select Case FileType
Case 1
.Filters.Add "Graphics Files", "*.jpg;*.bmp;*.gif;*.png"
Case 2
.Filters.Add "Files", "*.pdf;*.doc;*.docx;*.xls;*.rar"
Case Else
.Filters.Add "All Files", "*.*"
End Select
.AllowMultiSelect = False
If .Show Then
strSourceFile = .SelectedItems.Item(1)
strDestinationFile = strDestinationPath & Mid$(strSourceFile, InStrRev(strSourceFile, "\") + 1)
strFullFileName = Mid$(strSourceFile, InStrRev(strSourceFile, "\") + 1)
If bIsUpload = True Then
If FSO.FileExists(strDestinationFile) = True Then
If MsgBox("File already exit, do you want to cover", vbOKCancel + vbInformation, "Confirm!") = vbOK Then
FSO.CopyFile strSourceFile, strDestinationFile, True
Else
Exit Function
End If
Else
FSO.CopyFile strSourceFile, strDestinationFile
End If
Set FSO = Nothing
UploadFile = strDestinationFile
Else
UploadFile = strSourceFile
End If
End If
End With
ExitHere:
Set FSO = Nothing
Exit Function
ErrorHandler:
MsgBox Err.Description, vbInformation, "Promt"
Resume ExitHere
End Function
To use it, just put below code in an event:
Code:
Private Sub Change_Click()
Dim strDestinationPath As String
Dim strReturnFile As String
strDestinationPath = CurrentProject.Path & "\Picture"
If Dir(strDestinationPath, vbDirectory) = "" Then
MkDir (strDestinationPath)
Else
End If
strReturnFile = UploadFile(strDestinationPath & "\", acPicture, True)
If Len(strReturnFile) > 0 Then
Me.Sketch = strReturnFile
Me.imgPicture.Picture = strReturnFile
End If
End Sub
But how to save the picture with customized name, say "Materials 0001.Jpg"
Thanks