בעיה בקוד vba להורדת קובץ משרת ftp

אוריי

יש לי קוד vba שראיתי כאן
אני יביא גם כן לכאן את הקוד

Function DownloadFile(ByVal HostName As String, _
    ByVal UserName As String, _
    ByVal Password As String, _
    ByVal RemoteFileName As String, _
    ByVal LocalFileName As String) As Boolean

    Dim FTP As Inet

    Set FTP = New Inet
    With FTP
        .Protocol = icFTP
        .RemoteHost = HostName
        .UserName = UserName
        .Password = Password
        .Execute .URL, "Get " + RemoteFileName + " " + LocalFileName
        Do While .StillExecuting
            DoEvents
        Loop
        DownloadFile = (.ResponseCode = 0)
    End With
    Set FTP = Nothing
End Function

הגדרתי את הכל טוב (שם משתמש וסיסמה) אבל בכל זאת הוא מחזיר שגיאה כזו

אשמח לפתרון

נ.ב. לעניות דעתי הוא לא מצליח לגשת בכלל ל ftp עוד לפני השם משתמש וסיסמה

OdedDvir

@אוריי אתה צריך להוסיף הפנייה בעורך הVBA אל Microsoft Internet Transfer Control 6.0 (SP6). לשם כך אתה צריך את הקובץ MSINET.OCX. הוא לא קיים ב Windows 10. תנסה להשתמש בזה msinet.ocx או להוריד אחד מהאינטרנט.

אח"כ בעורך VBA תוסיף הפניה לקובץ:
Tools>Reference>Browse
בחלון שנפתח תסמן את הקובץ שהורדת (ייתכן וכדי לראותו תצטרך לשנות את סוג הקבצים המוצגים בחלון)

בהצלחה!

תוספת:
שכחתי שלב חשוב והוא לרשום את הספריה בWindows.
עבור Windows גרסת 32 ביט יש להעתיק את הקובץ ל C:\Windows\System32 ולהריץ שורת פקודה כמנהל כך:

regsvr32 C:\Windows\System32\MSINET.OCX

עבור גרסת 64 ביט צריך להעתיק ל C:\Windows\SysWOW64 ולהריץ שורת פקודה כמנהל כך:

regsvr32 C:\Windows\SysWOW64\MSINET.OCX

אוריי

@OdedDvir אמר בבעיה בקוד vba להורדת קובץ משרת ftp:

ולהריץ שורת פקודה כמנהל כך

סליחה על הבורות, איך אני מריץ את שורת הפקודה?

OdedDvir

@אוריי תלחץ על התחל ותרשום שורת הפקודה, ואח"כ "הפעל כמנהל"
1e5950ba-0942-49e5-949e-ea26ccb68da0-תמונה.png

אוריי

@OdedDvir
הרצתי את זה
הוא מחזיר לי הודעה כזו

אח"כ סגרתי את שורת הפקודה
וניסיתי שוב להפעיל את ה vba ומחזיר את השגיאה הזו

OdedDvir

@אוריי תנסה אולי להפעיל מחדש את המחשב.

אוריי

@OdedDvir לא עוזר.
אולי יש בעיה טכנית בקוד
ידוע לך על איזה קוד אחר שעושה את זה? אולי הוא יהיה יותר טוב..

אוריי

@OdedDvir
מצאתי עכשיו את הקוד הזה

Sub DownloadTransformUploadFTP()
Dim lngINetConn
Dim lngINet
Dim blnRC As Boolean
Dim UserName As String
Dim Password As String
Dim serverName As String
Const ASCII_TRANSFER = 1
Const BINARY_TRANSFER = 2
Dim fData As WIN32_FIND_DATA
Dim Check1
Dim Check2
 serverName = "testftp.com"
 UserName = "test"
 Password = "test"
 localFile = "C:\Test.xlsx"
 hostFile = "/outgoing/Test.xlsx"
blnRC = False
lngINet = InternetOpen("MyFTP Control", 1&, vbNullString, vbNullString, 0&)
If lngINet > 0 Then
lngINetConn = InternetConnect(lngINet, serverName, 0, UserName, Password, 1, 0, 0)
If lngINetConn > 0 Then
Check1 = FtpSetCurrentDirectory(lngINetConn, "/outgoing" + vbNullString)
fData.cFileName = String(MAX_PATH, 0)
Check2 = FtpFindFirstFile(lngINetConn, "Test.xlsx", fData, 0, 0)
blnRC = FtpGetFile(lngINetConn, "/outgoing/" & fData.cFileName, localFile, 0, 0, 1, 0)
InternetCloseHandle lngINetConn
End If
InternetCloseHandle lngINet
End If
Workbooks.Open Filename:=localFile

אבל גם הוא מחזיר שגיאה
כזו

OdedDvir

@אוריי איזו גרסת אקסס יש לך, 32 או 64 ביט?

אוריי

@OdedDvir
נראה לי שיש לי אופיס 64

אוריי

@OdedDvir
עכשיו מצאתי עוד קוד שאולי יכול לשפוך אור על הבעיה
זה הקוד

Function fnDownloadFile(ByVal strHostName, _
    ByVal strUserName As String, _
    ByVal strPassWord As String, _
    ByVal strRemoteFileName As String, _
    ByVal strLocalFileName As String) As String
     
    '// Set a reference to: Microsoft Internet Transfer Control
    '// This is the Msinet.ocx

    Dim FTP As Inet    'As InetCtlsObjects.Inet
    
    Set FTP = New Inet 'InetCtlsObjects.Inet
    
    On Error GoTo Errh
    With FTP
        .Url = strHostName
        .Protocol = 2
        .UserName = strUserName
        .Password = strPassWord
        .Execute , "Get " + strRemoteFileName + " " + strLocalFileName
        Do While .StillExecuting
            DoEvents
        Loop
        fnDownloadFile = .ResponseInfo
    End With
Xit:
    Set FTP = Nothing
    Exit Function

Errh:
    fnDownloadFile = "Error:-" & Err.Description
    Resume Xit
End Function

אבל עדיין הוא מחזיר שגיאה כזו

הקוד הזה ככל הנראה עובד על אותו הבסיס כמו הראשון שהבאתי

OdedDvir

@אוריי זה אותו דבר.
תכנס שוב ל Tools>Reference, תסמן את השורה Microsoft Internet Transfer Control 6.0 (SP6) ותעלה צילום

אוריי

@OdedDvir

OdedDvir

@אוריי רציתי את החלון של הReference לא את הודעת השגיאה

אוריי

@OdedDvir

OdedDvir

זו כנראה בעיה של גרסת 64 של אקסס, אצלי יש גרסת 32 ועובד.

בכל מקרה יש פתרון אחר בלי שימוש בספרייה הנ"ל, על ידי שימוש בקריאות לAPI של Windows.
יש לך כאן קוד VBA שמתאים גם ל64. תעתיק ותדביק במודול חדש:

Private Const FTP_TRANSFER_TYPE_UNKNOWN     As Long = 0
Private Const INTERNET_FLAG_RELOAD          As Long = &H80000000

Private Declare PtrSafe Function InternetOpenA Lib "wininet.dll" ( _
    ByVal sAgent As String, _
    ByVal lAccessType As Long, _
    ByVal sProxyName As String, _
    ByVal sProxyBypass As String, _
    ByVal lFlags As Long) As Long

Private Declare PtrSafe Function InternetConnectA Lib "wininet.dll" ( _
    ByVal hInternetSession As Long, _
    ByVal sServerName As String, _
    ByVal nServerPort As Long, _
    ByVal sUsername As String, _
    ByVal sPassword As String, _
    ByVal lService As Long, _
    ByVal lFlags As Long, _
    ByVal lcontext As Long) As Long

Private Declare PtrSafe Function FtpGetFileA Lib "wininet.dll" ( _
    ByVal hConnect As Long, _
    ByVal lpszRemoteFile As String, _
    ByVal lpszNewFile As String, _
    ByVal fFailIfExists As Long, _
    ByVal dwFlagsAndAttributes As Long, _
    ByVal dwFlags As Long, _
    ByVal dwContext As Long) As Long
    
Private Declare PtrSafe Function FtpPutFileA _
   Lib "wininet.dll" _
 _
       (ByVal hFtpSession As Long, _
        ByVal lpszLocalFile As String, _
        ByVal lpszRemoteFile As String, _
        ByVal dwFlags As Long, _
        ByVal dwContext As Long) As Boolean
 
Private Declare PtrSafe Function InternetCloseHandle Lib "wininet" ( _
    ByVal hInet As Long) As Long

Sub FtpDownload(ByVal strRemoteFile As String, ByVal strLocalFile As String, ByVal strHost As String, ByVal lngPort As Long, ByVal strUser As String, ByVal strPass As String)
    Dim hOpen   As Long
    Dim hConn   As Long

    hOpen = InternetOpenA("FTPGET", 1, vbNullString, vbNullString, 1)
    hConn = InternetConnectA(hOpen, strHost, lngPort, strUser, strPass, 1, 0, 2)

    If FtpGetFileA(hConn, strRemoteFile, strLocalFile, 1, 0, FTP_TRANSFER_TYPE_UNKNOWN Or INTERNET_FLAG_RELOAD, 0) Then
        Debug.Print "Success"
    Else
        Debug.Print "Fail"
    End If

    'Close connections
    InternetCloseHandle hConn
    InternetCloseHandle hOpen
End Sub
Sub FtpUpload(ByVal strLocalFile As String, ByVal strRemoteFile As String, ByVal strHost As String, ByVal lngPort As Long, ByVal strUser As String, ByVal strPass As String)
    Dim hOpen   As Long
    Dim hConn   As Long
 
    hOpen = InternetOpenA("FTPGET", 1, vbNullString, vbNullString, 1)
    hConn = InternetConnectA(hOpen, strHost, lngPort, strUser, strPass, 1, 0, 2)
 
    If FtpPutFileA(hConn, strLocalFile, strRemoteFile, FTP_TRANSFER_TYPE_UNKNOWN Or INTERNET_FLAG_RELOAD, 0) Then
        Debug.Print "Success"
    Else
        Debug.Print "Fail"
    End If
 
    'Close connections
    InternetCloseHandle hConn
    InternetCloseHandle hOpen
 
End Sub

יש שם גם דוגמאות
כדי להוריד קובץ:

 FtpDownload "//Download/text file.txt", "C:\text file.txt", _
              "192.168.0.100", 21, "username", "password"

כדי לשלוח קובץ:

  FtpUpload "C:\text file.txt", "//Download/text file.txt", _
            "192.168.0.100", 21, "username", "password"

אוריי

@OdedDvir
העתקתי והוא מחזיר שגיאה

OdedDvir

@אוריי צודק, שכחתי שמדובר ב-64 ביט. תיקנתי במקור. תנסה שוב

אוריי

@OdedDvir
הרבה תודה עד כה
כעת הוא מריץ רק חלק מן הקוד אבל לא מוריד אותו
איך אני יכול לדעת מה השגיאה ומה חסר לו?

OdedDvir

@אוריי אמר בבעיה בקוד vba להורדת קובץ משרת ftp:

כעת הוא מריץ רק חלק מן הקוד

מה הפירוש?

תחומים - פורום חרדי מקצועי

בעיה בקוד vba להורדת קובץ משרת ftp