اذهب الي المحتوي
أوفيسنا

ahmedsbra

عضو جديد 01
  • Posts

    2
  • تاريخ الانضمام

  • تاريخ اخر زياره

السمعه بالموقع

0 Neutral

عن العضو ahmedsbra

البيانات الشخصية

  • Gender (Ar)
    ذكر
  • Job Title
    lمحاسب
  1. 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
×
×
  • اضف...

Important Information