اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

الردود الموصى بها

قام بنشر (معدل)
Function DownloadDBFile(myURL As String, saveToPath As String)
Dim WinHttpReq As Object
Dim iTimer As Long
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False, "xxxxxxxxxxxx@gmail.com", "xxxxxxxxxxxxxxxx"
Debug.Print WinHttpReq.ReadyState
WinHttpReq.Send
'make sure readystate is finished
iTimer = Timer
Do While WinHttpReq.ReadyState = 1
'if 10 seconds elapse and nothing happens, abort:
If Timer - iTimer > 10 Then Exit Do
Loop
'readystate 4 = all data received
If WinHttpReq.ReadyState = 4 Then
    If WinHttpReq.Status = 200 Then
    Set oStream = CreateObject("ADODB.Stream")
    oStream.Open
    oStream.Type = 1
    oStream.Write WinHttpReq.responseBody
    oStream.SaveToFile saveToPath, 2 ' 1 = no overwrite, 2 = overwrite
    oStream.CLOSE
Me.waitfordownload.Visible = False
    Else
    MsgBox ("HTTP error: " & WinHttpReq.Status)
   End If
Else
MsgBox ("Couldn't get file")
End If
Set oStream = Nothing
Set WinHttpReq = Nothing
End Function

وفي زر الامر ضع الاتي 

If IsNull(savetox) Then
MsgBox "يرجى اختيار مكان حفظ التحديثات "
Else
Me.waitfordownload.Visible = True
Me.Requery

Me.TabDown.Value = 1
Dim PathDBFile  As String
Dim PathUpdateFolder As String

PathUpdateFolder = CurrentProject.path & "\" & "LinkToUpdate"
If Len(Dir(PathUpdateFolder, vbDirectory)) = 0 Then
MkDir path:=PathUpdateFolder
End If
DownloadDBFile UrlDB, Me.savetox
End If

 

تم تعديل بواسطه jjafferr
إظهار الكود بالطريقة الصحيحة بإستعمال زر <> من القائمة
  • 3 weeks later...

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.

سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information