Excel/VBA - Ladda upp en bild
Hej, jag har ett problem med ett formulär. Jag vill ladda upp en bild som får samma namn som ID på den raden som läggs till i databasen. Så jag vill bara välja bild, inte kopiera och döpa om den förräns raden i databasen har lagts till och fått sitt ID.
Jag är nybörjare och har kopierat delar av koden.
När man trycker på "Välj bild"
Private Sub CommandButton1_Click()
'skapa uppladdningsformulär för bilden'
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.ButtonName = "Submit"
.Title = "Select an image file"
.Filters.Add "Image", "*.gif; *.jpg; *.jpeg", 1
If .Show = -1 Then
'filen har valts'
Dim Path As String
Path = .SelectedItems(1)
Dim fsob As New FileSystemObject
Dim fileName As String
fileName = fsob.GetFileName(Path)
Dim fso As Object
Dim SourceFileName As String, DestinFileName As String
'skapa objektet'
Set fso = CreateObject("Scripting.Filesystemobject")
SourceFileName = .SelectedItems(1)
DestinFileName = "\\vcn.ds.volvo.net\vce-bra\proj03\027980\04.Stödfunktioner\10.VPS-Support\50.Robin-Lab\Pictures\" & fileName
'kopiera filen'
fso.CopyFile Source:=SourceFileName, Destination:=DestinFileName
MsgBox (SourceFileName + " uppladdad till " + DestinFileName)
Else
'användaren avbröt formuläret'
End If
End With
End Sub
Och koden som lägger till en rad i databasen
Private Sub CommandButton2_Click()
'variabler'
Dim db_section As String
Dim db_relatedto As String
Dim db_user As String
Dim db_date As String
'variabler för insert i databasen'
db_section = Me.ComboBox2.Value
db_relatedto = Me.ComboBox1.Value
db_user = Application.UserName
db_date = Date
'upprätta databasanslutning'
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim qry As String
'kolla så fälten inte är tomma'
If (Me.TextBox1.Value = "" Or Me.ComboBox1.Value = "" Or Me.ComboBox2.Value = "") Then
MsgBox ("Du måste fylla i alla fält")
Exit Sub
End If
'öppna databasen'
cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\users.mdb"
'sql query'
qry = "INSERT INTO BestPractice (bp_section, bp_relatedto, bp_user, bp_date) VALUES('" & db_section & "', '" & db_relatedto & "', '" & db_user & "', '" & db_date & "')"
rst.Open qry, cnn, adOpenKeyset, adLockOptimistic
MsgBox ("Exemplet inlagt i databasen!")
'återställ fälten till noll'
Me.ComboBox1.Value = ""
Me.ComboBox2.Value = ""
Me.TextBox1.Value = ""
End Sub
Båda ligger i UserForm1
