קוד לדוגמא: קובץ שיוצר קובץ במס"ב.

macroshadow

והנה עוד הצעת שיפור, להחליף את הקוד הנ"ל בזה.

הוא בודק אם ישנו חיבור לאינטרמת לפני נסיון הייבוא, ומבטל את הפעולה במידה ואינו קיים.
הודעה נשלחת לשורת הסטטוס בכל שלב, למען ידע המשתמש מה מתרחש.

Option Compare Database
Option Explicit

#If Win64 And VBA7 Then
Public Declare PtrSafe Function InternetGetConnectedState Lib "wininet.dll" (lpdwFlags As LongPtr, ByVal dwReserved As Long) As Boolean
#Else
Public Declare Function InternetGetConnectedState Lib "wininet.dll" (lpdwFlags As Long, ByVal dwReserved As Long) As Boolean
#End If

Sub DownloadFile(myURL As String, FileNameSave As String)

'myURL = "http://www.bankisrael.gov.il/he/BankingSupervision/BanksAndBranchLocations/Lists/BoiBankBranchesDocs/snifim.xls"
Dim WinHttpReq As Object
Dim oStream As Object
```
 ' בדיקה אם קיים חיבור לאינטרמת
 If InternetGetConnectedState(0, 0) Then
     Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
     WinHttpReq.Open "GET", myURL, False, "", ""
     WinHttpReq.send

     myURL = WinHttpReq.responseBody
     If WinHttpReq.Status = 200 Then
         Set oStream = CreateObject("ADODB.Stream")
         oStream.Open
         oStream.Type = 1
         oStream.Write WinHttpReq.responseBody
         oStream.SaveToFile FileNameSave, 2    ' 1 = no overwrite, 2 = overwrite
         oStream.Close
     End If

     Set WinHttpReq = Nothing
     Set oStream = Nothing
 Else
     MsgBox "לא זוהה חיבור לאינטרמת!" & "לא ניתן לעדכן את רשימת הסניפים.", vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, "מנותק!"
 End If
```
End Sub

Public Function ImportBranchXml()
On Error Resume Next
Dim sFile As String
SysCmd acSysCmdSetStatus, "מוחק טבלה זמנית..."
DoCmd.DeleteObject acTable, "Branch"
sFile = CurrentProject.Path & "" & Format(Now, "ddmmyyyynnss") & ".xml"
SysCmd acSysCmdSetStatus, "מוריד קובץ מאתר בנק ישראל..."
DownloadFile "http://www.bankisrael.gov.il/he/BankingSupervision/BanksAndBranchLocations/Lists/BoiBankBranchesDocs/snifim_he.xml", sFile
SysCmd acSysCmdSetStatus, "מייבא רשימת סניפים מהקובץ הזמני..."
ImportXML sFile
SysCmd acSysCmdSetStatus, "מוחק קובץ זמני..."
Kill sFile
SysCmd acSysCmdSetStatus, "מוחק את הסניפים מהטבלה"
CurrentDb.Execute "DELETE * FROM TblBanks"
SysCmd acSysCmdSetStatus, "מייבא רשימת סניפים מהטבלה הזמנית..."
CurrentDb.Execute "INSERT INTO tblBanks ( [קוד בנק], [שם בנק], [מס סניף], [שם סניף], [כתובת סניף], יישוב, מיקוד, טלפון, פקס ) SELECT BRANCH.Bank_Code, BRANCH.Bank_Name, BRANCH.Branch_Code, BRANCH.Branch_Name, BRANCH.Branch_Address, BRANCH.City, BRANCH.Zip_Code, BRANCH.Telephone, BRANCH.Fax FROM BRANCH;"
SysCmd acSysCmdSetStatus, "מוחק טבלה זמנית..."
DoCmd.DeleteObject acTable, "Branch"
SysCmd acSysCmdClearStatus
End Function

פורסם במקור בפורום CODE613 ב23/04/2014 17:37 (+03:00)

מלא 0

אולי מישהו יואיל ויועיל, להסביר לי מה פשרה של הפונקציה הזאת, ומה מטרתה.
תודה רבה

Public Function NullCheck(frm As Form) As Boolean

    Dim ctl As Control

    For Each ctl In frm
        If ctl.ControlType = acTextBox Then
            If ctl.Visible = True And ctl.Locked = False Then
                If IsNull(ctl) Then
                    NullCheck = True
                    Exit Function
                End If
            End If
        ElseIf ctl.ControlType = acSubform Then
            NullCheck = NullCheck(ctl.Form)
            If NullCheck = True Then Exit Function
        End If
    Next ctl

End Function

פורסם במקור בפורום CODE613 ב08/05/2014 23:12 (+03:00)

ארכיטקט

מטרה של פונקציה צריך לבדוק היכן נעשה בה שימוש, אבל מה שהיא עושה זה עוברת על הפקדים שיש בטופס ובודקת אם אחד מהם מכיל ערך null, ברגע שהיא נתקלת באחד הפקדים שמכיל ערך null היא מחזירה תשובה חיובית.

פורסם במקור בפורום CODE613 ב08/05/2014 23:19 (+03:00)

clickone

@מלא

אולי מישהו יואיל ויועיל, להסביר לי מה פשרה של הפונקציה הזאת, ומה מטרתה.
תודה רבה

Public Function NullCheck(frm As Form) As Boolean

    Dim ctl As Control

    For Each ctl In frm
        If ctl.ControlType = acTextBox Then
            If ctl.Visible = True And ctl.Locked = False Then
                If IsNull(ctl) Then
                    NullCheck = True
                    Exit Function
                End If
            End If
        ElseIf ctl.ControlType = acSubform Then
            NullCheck = NullCheck(ctl.Form)
            If NullCheck = True Then Exit Function
        End If
    Next ctl

End Function

ואני בכלל לא ידעתי שיש שם כזו פונקצייה.. :lol: :lol: :lol: :lol: (אני רק שיפרתי את מה שמוישי מפרוג [MacroShadow?] עשה..)

פורסם במקור בפורום CODE613 ב08/05/2014 23:58 (+03:00)

תלת

]שלום רב,
הגעתי לכאן עם הפניה מאתר פרוג.
ראשית תודה רבה על כל ההשקעה.
אני מקבל הודעת שגיאה שהקובץ אינו מתאים ל64 ביט.
האם מישהו יוכל להעלות קובץ מותאים ל-64 ביט. וכן אם אפשר עם התיקונים שהובאו בסוף האשכול.
תודה רבה

לכידה.PNG

פורסם במקור בפורום CODE613 ב21/06/2015 13:14 (+03:00)

hubhcbh

כדי שזה יעבוד גם ב 32 וגם ב64 צריך להוסיף תנאי, ומילת קוד.
מילת המפתח היא PtrSafe
לדוגמה הקוד הבא

#If VBA7 Then
  'הקוד הזה יעבוד על 64 ביט
  'בין Declare ל Function הוספנו PtrSafe

    Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

#Else

'הקוד הזה יעבוד על 32 ביט
    Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
#End If

אל תשכח להוסיף את התנאי...

פורסם במקור בפורום CODE613 ב21/06/2015 13:24 (+03:00)

תלת

HUBHCBH, תודה רבה!

פורסם במקור בפורום CODE613 ב21/06/2015 21:16 (+03:00)

macroshadow

@HUBHCBH

כדי שזה יעבוד גם ב 32 וגם ב64 צריך להוסיף תנאי, ומילת קוד.
מילת המפתח היא PtrSafe
לדוגמה הקוד הבא
#If VBA7 Then
  'הקוד הזה יעבוד על 64 ביט
  'בין Declare ל Function הוספנו PtrSafe

    Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

#Else

'הקוד הזה יעבוד על 32 ביט
    Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
#End If
אל תשכח להוסיף את התנאי...

כמעט מדוייק...

#If Win64 And VBA7 Then

Private Type BROWSEINFO
    hOwner As LongPtr
    pidlRoot As LongPtr
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As LongPtr
    lParam As LongPtr
    iImage As Long
End Type

Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As LongPtr
Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

#Else

Private Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type

Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

#End If

פורסם במקור בפורום CODE613 ב22/06/2015 18:41 (+03:00)

תלת

מה הבעיה כאן?
תודה

32.PNG
31.PNG

פורסם במקור בפורום CODE613 ב22/06/2015 21:28 (+03:00)

hubhcbh

למה לא עשית פה תנאי ל 64?

כל מקום שיש שורה אדומה (שהיא בגלל 64ביט) תוסיף את התנאי

פורסם במקור בפורום CODE613 ב23/06/2015 01:39 (+03:00)

ליכט

אני משתמש עם התוכנה הזאת באופן קבוע כבר למעלה משנה אך לאחרונה היא התחילה לציין לי על חשבונות תקינות שהם אינם תקינות, והיא לא נותנת לי לייצא קבצי מס"ב כל עוד החשבונות (הלא) תקינות נמצאות ברשימה, כאן: (http://www.prog.co.il/showthread.php?t=254810) פורסם תוכנה לבדיקת חוקיות חשבון בנק מאותו מחבר, ושם החשבונות נמצאות תקינות, אולי מישהו יכול לשלב אותם, דחוף לי מאד, תודה.

פורסם במקור בפורום CODE613 ב08/03/2016 17:17 (+02:00)

ליכט

מוישי מפרוג כבר תיקן א"ז: http://www.prog.co.il/showthread.php?t=254810

פורסם במקור בפורום CODE613 ב09/03/2016 11:36 (+02:00)

macroshadow

כאן יש עדכון http://www.prog.co.il/showpost.php?p=2017816&postcount=11

פורסם במקור בפורום CODE613 ב10/03/2016 08:15 (+02:00)

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

קוד לדוגמא: קובץ שיוצר קובץ במס"ב.