Εμφάνιση ενός μόνο μηνύματος
  #9  
Παλιά 17-10-13, 09:17
Το avatar του χρήστη Tasos
Tasos Ο χρήστης Tasos δεν είναι συνδεδεμένος
Διαχειριστής
Όνομα: Τάσος Φιλοξενιδης
Έκδοση λογισμικού 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.
Απάντηση με παράθεση