הוספת מיקוד אוטומטי בקובץ אקסל

[Avi_av]

@by6199 אמר בהוספת מיקוד אוטומטי בקובץ אקסל:

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

אז את אלו שלא יזהו אוטומטית - תמלא ידנית..
את העבודה הקשה חסכת.

בכל מקרה, api חיצוני אמור להתאים.
אשכול בפרוג על קוד vba לעניין

[by6199]

@avi_av אמר בהוספת מיקוד אוטומטי בקובץ אקסל:

@by6199 אמר בהוספת מיקוד אוטומטי בקובץ אקסל:

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

אז את אלו שלא יזהו אוטומטית - תמלא ידנית..
את העבודה הקשה חסכת.

בכל מקרה, api חיצוני אמור להתאים.
אשכול בפרוג על קוד vba לעניין

ראיתי, לא יודע איך להגדיר בקובץ, האקסס שם לא תקין ובנוסף זה אחד אחד את זה גם ניתן לעשות באתר הדואר

[yits]

@by6199

אם אתה עדיין צריך קוד, מצאתי משהו שעשיתי עם הקוד שפורסם בפרוג.
Module1.bas

אתה צריך להכניס את הקובץ לתוך הפרוייקט שלף באקסס,
הפונקציה הראשונה פותחת שאילתה של טבלת "נתונים" ובודקת אם השדה "מיקוד" הוא ריק,
במקרה שהתשובה חיובית, הוא לוקח את הפרמטרים הבאים "רחוב,עיר,בית,כניסה" מתוך הטבלה ויוצר URL, התשובה שמתקבלת מתעדכנת ישירות בטבלת נתונים.

' השורה הראשונה עבור אקסס בלבד
Option Compare Database
Option Explicit

Sub Demo()

    Dim rs As DAO.Recordset
    Dim strUrl As String

    Set rs = CurrentDb.OpenRecordset("נתונים")

    With rs
        .MoveFirst
        Do Until rs.EOF
      
            If Nz(!מיקוד) = "" Then

                strUrl = "http://www.israelpost.co.il/zip_data1.nsf/SearchZip?OpenAgent"
                strUrl = strUrl & "&Location=" & UnicodeEncode(!עיר)
                strUrl = strUrl & "&POB="
                strUrl = strUrl & "&Street=" & UnicodeEncode(!רחוב)
                strUrl = strUrl & "&House=" & UnicodeEncode(!בית)
                strUrl = strUrl & "&Entrance=" & UnicodeEncode(!כניסה)
            
                .Edit
                !מיקוד = GetZipCode(strUrl, False)
                .Update
                If !מיקוד <> 0 Then
                    Debug.Print !עיר & vbTab & !רחוב & vbTab & !בית & vbTab & !מיקוד
                End If
            End If
           
            .MoveNext
             
        Loop
    End With

End Sub

Public Function UnicodeEncode(str) As String
    If IsNull(str) Then Exit Function
    Dim i, a
    For i = 1 To Len(str)
        a = AscW(Mid(str, i, 1))
        If a > -1 And a < 127 Then
            UnicodeEncode = UnicodeEncode & "%" & String(2 - Len(Hex(a)), "0") & Hex(a)
        ElseIf a > -1 Or a < 65535 Then
            UnicodeEncode = UnicodeEncode & "%u" & String(4 - Len(Hex(a)), "0") & Hex(a)
        End If
    Next
End Function

Function GetZipCode(strUrl As String, Optional blnAlert As Boolean = True) As Long

    Dim oHttpRequest As Object
    Dim strResult As String

    Set oHttpRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
    oHttpRequest.Open "GET", strUrl

    ' שליחת בקשה '
    oHttpRequest.Send

    ' נקבל תוצאה זו '
    strResult = oHttpRequest.ResponseText

    ' הוצאת המיקוד 7 ספרות '
    If InStr(1, strResult, "ישוב או רחוב לא קיים") > 0 Then
        GetZipCode = 0
    ElseIf InStr(1, strResult, "לא נמצא מיקוד") > 0 Then
        GetZipCode = 0
    ElseIf InStr(1, strResult, "למבנה קיימות מס' כניסות – לקבלת המיקוד המדויק לכניסה - נא לבחור כניסה") > 0 Then
        GetZipCode = Mid(strResult, InStr(1, strResult, "</body>") - 78, 7)
        If blnAlert Then MsgBox "למבנה קיימות מס' כניסות – לקבלת המיקוד המדויק לכניסה - נא לבחור כניסה.", vbMsgBoxRight + vbMsgBoxRtlReading + vbInformation
    Else
        GetZipCode = Mid(strResult, InStr(1, strResult, "</body>") - 8, 7)
    End If

    Set oHttpRequest = Nothing

End Function

Function GetRate(strUrl As String) As Double

    Dim oHttpRequest As Object
    Dim strResult As String

    Set oHttpRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
    oHttpRequest.Open "GET", strUrl

    ' שליחת בקשה '
    oHttpRequest.Send

    ' נקבל תוצאה זו '
    strResult = oHttpRequest.ResponseText

''<ERROR1>
    GetRate = Mid(strResult, _
        InStr(1, strResult, "<RATE>") + 6, _
        InStr(1, strResult, "</RATE>") - InStr(1, strResult, "<RATE>") - 6)

    Set oHttpRequest = Nothing

End Function

[by6199]

@yits לצערי מעולם לא התעסקתי לבד באקסס, וזה נשמע לי גדול קצת...

[yits]

@by6199

מה אתה רוצה לעשות לעדכן פריט יחיד או טבלה שלמה?

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

[by6199]

@yits אמר בהוספת מיקוד אוטומטי בקובץ אקסל:

@by6199

מה אתה רוצה לעשות לעדכן פריט יחיד או טבלה שלמה?

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

לעדכן טבלה.

בודד כבר הייתי מעתיק מהדואר

[yits]

@by6199
אני התכוונתי לשאול האם אתה רוצה שבהוספת איש קשר אוטמטי יתווסף לו מיקוד
או פעם ב... תפעיל שאילתה של הוספת/ עדכון מיקוד לכולם.

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

[ימהר]

@by6199
קח קובץ אקסס שיעשה לך את זה.
תדביק את הנתונים שלך בטבלה, והפעל את הלחצן
0_1536705537649_קבלת מיקוד.accdb

[shloymi]

@ימהר ניסיתי לעבוד עם הקובץ אך הוא מחזיר תשובה של בעיה בשרת.
האם מישהו יודע מה הבעיה בקוד שלכן הוא לא מאפשר את קבלת המיקוד?

[מוטי מן]

פוסט זה נמחק!

[yossidror]

פוסט זה נמחק!