בעיה בקוד vba להורדת קובץ משרת 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]

@אוריי תלחץ על התחל ותרשום שורת הפקודה, ואח"כ "הפעל כמנהל"

[אוריי]

@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:

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

מה הפירוש?

[OdedDvir]

טוב, אחרי שקצת חיפשתי מידע בנושא, נראה שאין פתרון פשוט לבעיה על ידי VBA בלבד הגעתי לכמה מסקנות:

1. הגישה לשרת FTP כיום שונה מהגישה שהיתה בתקופת כתיבת הקוד הנ"ל. כיום משתמשים במצב שנקרא Passive Mode (כנראה מטעמי אבטחה)
2. ל-Windows אין מנגנון מובנה לכך.

כדי לגשת בצורה מאובטחת לשרת FTP יש צורך בתוכנה חיצונית.
פתרון אפשרי (טלאי) אולי הוא ליצור Script טקסט עבור התוכנה החיצונית, ולהריץ אותו מתוך VBA...

אשמח אם יש למבינים בנושא משהו להוסיף.