Temat: Dodawanie zdjęć z internetu
Witam,
Znamy.
0. Potrzebujemy kod w VBA, który będzie w stanie na podstawie danych z tabeli dostać się do każdego jednego linka do zdjęcia
Przykład -
http://msdn.microsoft.com/en-us/library/bb243789%28v=o...:
Sub UpdateEmployees()
Dim dbsNorthwind As DAO.Database
Dim rstEmployees As DAO.Recordset
Dim strSQL As String
Dim intI As Integer
On Error GoTo ErrorHandler
Set dbsNorthwind = CurrentDb
'Open a recordset on all records from the Employees table that have
'a Null value in the ReportsTo field.
strSQL = "SELECT * FROM Employees WHERE ReportsTo IS NULL"
Set rstEmployees = dbsNorthwind.OpenRecordset(strSQL, dbOpenDynaset)
'If the recordset is empty, exit.
If rstEmployees.EOF Then Exit Sub
intI = 1
With rstEmployees
Do Until .EOF
.Edit
![ReportsTo] = 5
![Title] = "Temporary"
![Notes] = rstEmployees![Notes] & "Temp #" & intI
.Update
.MoveNext
intI = intI + 1
Loop
End With
RstEmployees.Close
dbsNorthwind.Close
Set rstEmployees = Nothing
Set dbsNorthwind = Nothing
Exit Sub
ErrorHandler:
MsgBox "Error #: " & Err.Number & vbCrLf & vbCrLf & Err.Description
End Sub
1. Potrzebujemy kod w VBA, który będzie w stanie ściągnąć na podstawie linka plik ze zdjęciem na dysk
Przykład -
http://www.ozgrid.com/forum/showthread.php?t=141980:
Option Explicit
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
(ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long
Private Const ERROR_SUCCESS As Long = 0
Private Const BINDF_GETNEWESTVERSION As Long = &H10
Private Const INTERNET_FLAG_RELOAD As Long = &H80000000
Public Function DownloadFile(sSourceURL As String, _
sLocalFile As String) As Boolean
DownloadFile = URLDownloadToFile(0&, _
sSourceURL, _
sLocalFile, _
BINDF_GETNEWESTVERSION, _
0&) = ERROR_SUCCESS
End Function
Sub RunPPT()
Dim sURL As String
Dim sLocalFile As String
Dim sDestination As String
Dim sText As String
Dim PPTShape
sText = "http://www.informationactive.com/affiliates/ad-180x60-2.gif"
sURL = sText
sLocalFile = "c:\test\PPTImage.jpg"
DownloadFile sURL, sLocalFile
End Sub
2. Potrzebujemy kod, który wstawi zdjęcie z dysku do bazy danych.
Przykład -
http://www.access-programmers.co.uk/forums/showthread....:
On Error GoTo Err_AddImage
Dim db As DAO.Database
Dim rsParent As DAO.Recordset2
Dim rsChild As DAO.Recordset2
Set db = CurrentDb
Set rsParent = Me.Recordset
rsParent.Edit
Set rsChild = rsParent.Fields("AttachmentTest").Value
rsChild.AddNew
rsChild.Fields("FileData").LoadFromFile ("c:\Sunset.jpg")
rsChild.Update
rsParent.Update
Exit_AddImage:
Set rsChild = Nothing
Set rsParent = Nothing
Exit Sub
Err_AddImage:
If Err = 3820 Then
MsgBox ("File already part of the multi-valued field!")
Resume Next
Else
MsgBox "Some Other Error occured!", Err.Number, Err.Description
Resume Exit_AddImage
End If
3. Potrzebujemy kod, który uruchomi kod nr 0 i nr 1 i nr 2 w momencie kiedy... należy je uruchomić.
Przykład - kod uruchamiający makra w momencie załadowania formularza:
Private Sub Form_Load()
On Error GoTo err_Form_Load
Call makroprzegladajacetabele
...
Call makroaktualizujace
Exit Sub
err_Form_Load:
MsgBox "Some Other Error occured!", Err.Number, Err.Description
End Sub
4. Można również pomyśleć nad kodem usuwającym zdjęcia z dysku -
http://word.mvps.org/faqs/macrosvba/DeleteFiles.htm
Pozdrawiam!
Ten post został edytowany przez Autora dnia 29.12.14 o godzinie 22:26
пропозиції роботи
