
17-10-13, 09:17
|
 | Διαχειριστής Όνομα: Τάσος Φιλοξενιδης Έκδοση λογισμικού Office: Ms-Office 365 Γλώσσα λογισμικού Office: Ελληνική, Αγγλική, Γερμανική | | Εγγραφή: 21-10-2009
Μηνύματα: 2.030
| |
Το αρχείο που σου έστειλα κάνει αυτήν ακριβώς τη δουλειά.
Κάνει λήψη του αρχείου από το Internet, το αποθηκεύει στο φάκελο "MyData" (αντικαθιστά το παλιό) και ενημερώνει τον πίνακα στο "Φύλλο1" που είναι συνδεδεμένος με το αρχείο αυτό.
Αν αντιμετωπίζεις πρόβλημα ανανέωσης, αυτό οφείλεται στις ρυθμίσεις Internet του υπολογιστή σου.
Σ αυτή την περίπτωση μπορείς να αντικαταστήσεις τον κώδικα του παραδείγματος μου με τον παρακάτω (32 - 64 bit): Κώδικας: Option Explicit
#If VBA7 Then
#If Win64 Then
Private Declare PtrSafe Function DownloadXLToFile Lib "urlmon" _
Alias "URLDownloadToFileA" ( _
ByRef pCaller As LongPtr, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserve As Long, _
ByRef lpfnCB As LongPtr) _
As LongPtr
Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "wininet" _
Alias "DeleteUrlCacheEntryA" _
(ByVal lpszUrlName As String) As Long
#Else
Private Declare Function DownloadXLToFile 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 Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" _
Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
#End If
#Else
Private Declare Function DownloadXLToFile 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 Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" _
Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
#End If
Sub RefreshData()
Dim XLTempName As String
Dim XLPath As String
Dim XLLocalName As String
Dim XLRemoteName As String
Dim ret As Long
Dim fso As New Scripting.FileSystemObject
XLTempName = Environ("TEMP") & "\x.xlsx"
XLPath = "C:\MyData"
XLLocalName = XLPath & "\xlData.xlsx"
XLRemoteName = "http://www.ms-office.gr/xl/xlData.xlsx"
If Not fso.FolderExists(XLPath) Then fso.CreateFolder XLPath
DeleteUrlCacheEntry XLRemoteName
ret = DownloadXLToFile(0, XLRemoteName, XLTempName, 0&, 0&)
If ret <> 0 Then
MsgBox "Σφάλμα κατά τη μεταφόρτωση!, vbExclamation"
Exit Sub
End If
If fso.FileExists(XLLocalName) Then
On Error Resume Next
fso.DeleteFile XLLocalName
If Err <> 0 Then
MsgBox "Σφάλμα: " & Err & vbLf & Err.Description, vbExclamation
Exit Sub
End If
End If
fso.MoveFile XLTempName, XLLocalName
Range("A1").ListObject.QueryTable.Refresh BackgroundQuery:=False
End Sub
Φρόντισε να εγκαταστήσεις έκδοση 32 bit για να γλυτώσεις από πολλά προβλήματα.
Τάσος
__________________ Ms-Office Development Team Ανάπτυξη επαγγελματικών εφαρμογών
Τελευταία επεξεργασία από το χρήστη Tasos : 17-10-13 στις 20:22.
|