ארכיון הקטגוריה: Access

העברת DB מ- Access על Sql Server באמצעות SSMA

בפוסט הזה אני מציין מספר נקודות מעניינות לגבי העברה של DB מסביבת Access אל Sql Server ( במקרה שלי גירסת Exrpress )

1- מיקרוסופט הסירו מאקסס את האפשרות  לייצא ישירות ל- SQL SERVER

הם ממליצים להשתמש בכלי שלהם שנקרא Sql Server Migration Assitant

יש גירסאות שלו עבור כמה סוגי DB נפוצים ( MySQL ועוד )

 

2- הכלי עובד יפה, אם כי לא אינטואיטיבי כל כך – ועל כך הפוסט הזה.

דברים שצריך לשים לב אליהם :

שלב 1  – יצוא הטבלאות מ- Access אל Sql Server

 

  • עוד לפני שמפעילים את הכלי – צריך להיות מודעים להתאים גירסת האופיס לגירסת הכלי ( ה=SSMA)
    אם ה-Access הוא בגירסת 32 ביט, צריך להפעיל את ה-SSMA 32 Bit  ( כי ה-Default הוא 64  ביט )
    שימו לב שההתקנה הרגילה מתקינה אצלכם ברשימת התוכניות – 2 גירסאות (32+64 )
    אם לא מפעילים את הגירסה שתואמת ל-Office שמותקן על המכונה, מקבלים בהמשך הודעת שגיאה שה-DB שניסיתם לטעון בלתי ניתן לקריאה…מה שכמובן לא נכון.
  • יצירת DB – לפני שמפעילים את הכלי, יש לייצור DB ב-SQL Server  שיקבל את הטבלאות שנייצא.
  • יצירת USER עבור ה-DB – שרת ה-Sql server מציע 2 צורות של אוטנטיקציה.
    אם משתמשים ב-Windows Auth… על אותה מכונה, לרוב לא תהיה בעיה.
    אם זה תחת שרתים אירגוניים, צריך לוודא שליוזרים יש הרשאות ל-DB,
    חשוב  לתת ליוזרים הרשאות , גם תחת "Security" של ה-Sql Server (=הכללי בעץ)
    וגם תחת Security של ה-DB הספציפי.
    אפשרות קצת פשוטה יותר -היא שימוש ב-Sql Auth, וגם שם צריך לוודא שהיוזר שיצרתם, מורשה הן לגישה ל-Server והן ל-DB הספציפי.
  • כאשר סף סוף מפעילים את הכלי – עדיף לא להשתמש ב-wizard שקופץ בכניסה – הוא אומנם מוביל שלב אחרי שלב, אך מדלג  על חלק מהשלבים, ולכן לא כל כך עוזר…
  • הגדרה שכדאי, ואפילו חובה לבצע עוד בהתחלה, היא להיכנס למקום שבו מוגדר לאיזה סוג שדה הופך כל אחד מהשדות ( למשל :  שדה TEXT של Access הופך ל- nvarchar של Sql Server וכדומה )
    זה נעשה תחת Tools < Default Project Settings > Type Mapping
    כל ההגדרות תקינות …חוץ מאשר….Date של Access  – שמועבר בצורה שגויה אל Datetime(2) של Sql Server , הבעיה היא, שכאשר נסיים את תהליך העברת הטבלאות, ונקשור את הטבלאות בחזרה אל פרוייקט ה-Access שלנו, תהיה לנו בעיה – ש-Access לא יודע לקרוא את סוג השדה הזה , ולכן ממיר אותו אל Text …וזה כבר יוצר שגיאות וולידציה, ובעיות בקוד ה-VBA שמצפה ל- Datetime.
    הפתרון הוא להגדיר את השדות כ- Datetime רגיל ( בלי ה-2 )
    במקרה זה – ההמרה עוברת תקין.
  • השלב הראשון, הוא "יצירת פרוייקט" (דרך התפריט או דרך כפתור למעלה)
    חשוב לשים לב – לבחור במסך יצירת הפרוייקט את גירסת ה- Sql Server שלכם
    ה-DropDown הוא כמעט מוסתר, וברירת המחדל היא Azure….מה שלא בטוח שהתכוונתם.

    • נקודה נוספת באותו עניין – יש אפשרות להגדיר את זה תחת Tools > Defailt project settings  (גם כאן ה-Dropdown נסתר מהעין)
  • לאחר שמוסיפים את ה-DB של Access באמצעות Add Databases , יש לבצע שמירה של הפרויקט – השמירה גורמת ל-SSMA לטעון את ה-Metadata של הטבלאות.
    למה…ככה (מיקרוסופט ? )
  • השלב הבא הוא חיבור ל-SQL SERVER,  אם לא בחרתם מראש בגירסת ה-SQL SERVER הנכונה, אזי לא תוכלו להתחבר ל-SQL שלכם.
  • בסוף אחרי שהכל מוגדר , כדי לגרום לכפתור ה- Convert-Load_AND-MIGRATE לעבוד , חייבים ללחוץ ללחוץ על ה-Access DB הרלוונטי – ורק אז הכפתור הופך ל-Enabled
  • לאחר לחיצה על כפתור המרה ( Convert..load..and migrate )
    הכלי עובד די מהר וחלק, טוען את כל הטבלאות , ובונה אותן, כולל את המפתחות הזרים והאינדקסים.  אפשר לומר שזה החלק הטוב בכלי הזה, שבסופו של דבר הוא באמת מבצע את העבודה.

שלב 2 – חיבור של קובץ ה-Access אל הטבלאות ב-Sql Server

זה תהליך די מוכר לכל מתכנת Access, ואכתוב אותו בקצרה :

  • מוחקים ( בלי לפחד 🙂 ) את הטבלאות המקוריות ( בין אם הם מקושרות, ובין אם מאוחסנות בקובץ הזה )
  • תחת "נתונים חיצוניים" > יבוא וקישור >  מסד נתונים של ODBC > ניצור Connection חדש או בקובץ, או של מערכת ההפעלה  ולאחר יצירת ה-Connection נבחר בו כדי לקשור את הטבלאות.
    • בשלב יצירת ה-Connection יש לבחור בדרייבר של Sql Server , או Sql Server ODBC Driver
    • באחד ממסכי יצירת ה-Connection יש לשים לב לאפשרות של בחירת ה-Default Database – ולהפעיל אותה רק על ה-DB הרלוונטי ב-SQL Server
  • לאחר שנבחר ב-Connection שיצרנו – נסמן את הטבלאות לקישור, יש לשים לב לא לסמן גם את טבלאות המערכת של Sql server , אלא רק את הטבלאות המקוריות ששיכות לפרויקט שלנו ( זה לא משנה, אבל חבל סתם להעמיס טבלאות מקושרות שלא נחוצות על הפרוייקט)
  • אם אתם לא רוצים לשגע את היוזרים – כדאי לסמן את האפשרות לשמור את הסיסמה ( ואז ללחוץ על אישור בנפרד לכל אחת מהטבלאות….מיקרוסופט …!!!! )
  • זה עוד לא נגמר …בשלב זה, כיוון שהטבלאות ב-Sql Server מתחילות תחת "איזור" שנקרא לרוב dbo. אז בקישור ל-Access, פתאום מתווסף לכל הטבלאות בתחילת השם, הביטוי dbo_ , צריך לעבור טבלה-טבלה, ולשנות את השם בחזרה לשם המקורי. (או לכתוב\למצוא סקריפט שעושה זאת …)
    אחרת – אם לא נעשה זאת, השאילתות שלנו לא יעבדו.
  • וכאן הגיע הזמן לבדוק שהכל תקין.

בהצלחה.

 

נקודה אחרונה, אך ממש לא קשורה – למי שמפתח Web על אותה מכונה שעליה מותקן ה-Sql Server.

אחד ה-Services שמופעלים בהתקנת ה-Sql Server, נקרא Sql Server Reporting Service

ולמרבה הפלא …הוא תופס את Port 80  ….

כך שאם רוצים להמשיך לעבוד , צריך : או להשבית אותו ( services.msc וכו' )  או להמשיך לעבוד בפורט אחר עבור ה-localhost על המכונה.

פונקצית VBA לחישוב ערכים באמצעות אקסל חיצוני (למשל מאקסס או מוורד)

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

להלן פונקציה שכתבתי ששולחת נתונים לאקסל, ומקבלת בחזרה נתונים לאחר החישוב

פונקציה זו נועדה לחשב דברים באמצעות אקסל
יש לספק 3 פרמטרים:
1. שם הקובץ
2. מערך המכיל את המידע שיש לשתול באקסל
3. מערך המכיל את התאים שיש לקבל מאקסל
הפונקציה שותלת את המערך מהפרמטר השני
ואז ממלאת את המערך מהפרמטר השלישי ומחזירה אותו
כלומר תוצאה הפונקציה היא מערך!
במקרה של תקלה – תוצאה הפונקציה תהיה בוליאנית – שקר

מבנה המערכים –
שתי המערכים באותו מבנה – דו מימדי, כאשר תיאור העמודות נשמר ב
ENUM = E_XL_DataAry

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

הערה : הפונקציה שמוזכרת פה IsArrayAllocated, היא פונקציה רק שבודקת האם זהו מערך תקין, ואינה מחויבת (היא לא חלק מ-VBA, אלא בנפרד).

Public Enum E_XL_DataAry
    
    SheetNameCol = 0
    CellAddressCol = 1
    ValueCol = 2

End Enum


Public Function CalculateByExcel(file_name As String, DataToPutAry As Variant, DataToGetAry As Variant) As Variant
    
    Dim xl As Object, wb As Object, ws As Object, I As Integer
    'open the xl
    Set xl = CreateObject("Excel.Application")
    xl.Visible = False
    Set wb = xl.Workbooks.Open(file_name, 2, True)
    
    If (Not IsArrayAllocated(DataToPutAry)) Or (Not IsArrayAllocated(DataToGetAry)) Then GoTo Err_Handel
    
    'Put Data into cells
    For I = LBound(DataToPutAry) To UBound(DataToPutAry)
            wb.Worksheets(DataToPutAry(I, E_XL_DataAry.SheetNameCol)).range(DataToPutAry(I, E_XL_DataAry.CellAddressCol)).Value = DataToPutAry(I, E_XL_DataAry.ValueCol)
    Next I
    
    For I = LBound(DataToGetAry) To UBound(DataToGetAry)
            DataToGetAry(I, E_XL_DataAry.ValueCol) = wb.Worksheets(DataToGetAry(I, E_XL_DataAry.SheetNameCol)).range(DataToGetAry(I, E_XL_DataAry.CellAddressCol)).Value
    Next I
     
    CalculateByExcel = DataToGetAry
     
    wb.Close False ' close the source workbook without saving any changes
    Set wb = Nothing
    xl.Quit
    Set xl = Nothing

Exit_Func:
    Exit Function


Err_Handel:
    CalculateByExcel = False
    Resume Exit_Func
    
End Function

דוגמא לשימוש פשוט – כאשר מוחזר רק תא אחד בודד


Sub TryIt()
Dim x As Variant, a As Variant, b As Variant
ReDim a(0, 3)
a(0, 0) = "Sheet1"
a(0, 1) = "A1"
a(0, 2) = "1"
ReDim b(0, 3)
b(0, 0) = "Sheet1"
b(0, 1) = "A2"


x = CalculateByExcel("YourXLFile.xlsx", a, b)
Debug.Print x(0, 2)

End Sub

ודוגמא לשימוש מורכב יותר, כאשר מוחזר טווח של 2 תאים לדוגמא


Dim x As Variant, a As Variant, b As Variant
ReDim a(0, 3)
a(0, 0) = "Sheet1"
a(0, 1) = "A1"
a(0, 2) = "1"
ReDim b(0, 3)
b(0, 0) = "Sheet1"
b(0, 1) = "A2:A3"


x = CalculateByExcel("YourXLFile.xlsx", a, b)
Debug.Print x(0, 2)(1,1)

End Sub

בהצלחה!

המתנה ב-ACCESS VBA באמצעות WINDOWS API

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

להלן קוד.

#If VBA7 Then
    Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If


Sub SleepVBA(ms As Integer)
'ms = milisecondes
Sleep ms
End Sub

העברת ADO RECORDSET אל מערך ב-VBA

קורה לפעמים שעדיף לרוץ על מערך בזיכרון מאשר על רקורדסט – זה הרבה הרבה יותר מהיר

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


Public Function RecordsetToArray(ByRef rs As Object) As Variant
    Dim tmp As Variant, cols_num As Integer, K As Integer, rows_num As Integer, J As Integer
    
    If Not (rs.EOF And rs.BOF) Then
    
        rs.MoveFirst
        cols_num = rs.fields.Count
        rows_num = rs.RecordCount
        
        ReDim tmp(rows_num, cols_num)
            
            J = 0
            Do While Not rs.EOF
                For K = 0 To cols_num - 1
                      tmp(J, K) = Nz(rs.fields(K).Value, "")
                Next K
                J = J + 1
                rs.MoveNext
            Loop
    
    Else
        tmp = Array("")
    
    End If
    
    RecordsetToArray = tmp
    
End Function




שימוש ב-Web Control המובנה של Access (דפדפן) ב-VBA

בגירסאות האחרונות של Microsoft Access יש Web Control מובנה

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

ב-VBA הגישה היא כזו :

.YourWebControl.ControlSource = "=" & Chr(34) & file_name & Chr(34)

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

YourWebControl.ControlSource = "=""www.google.co.il""

הצגת מונה רשומות בתוך טופס Access

באקסס , פעמים מסוימות נרצה להציג מונה רשומות בתוך הטופס עצמו

ולא להשתמש במונה המובנה של אקסס

 

השיטה הכי פשוטה היא לעשות תיבת טקסט ובתוכה

=" Record  " & [CurrentRecord] & " From  " & Count(*)


אבל  הבעיה היא שהשיטה הזו מחזיקה מעמד רק עד שפותחים רשומה חדשה

ברגע שפותחים רשומה חדשה – מקבלים דברים מוזרים כמו "רשומה 7 מתוך 6" וכדומה.

 

אז שיטה יותר טובה היא לשים באירוע של OnCurrent ( בנוכחי) קוד שבמידה והטופס נמצא על רשומה קימת – נשתמש ב-DCount כדי למנות את מספר הרשומות הקיים.

 

 If Me.NewRecord Then
 Me.txtCounter.Value = "New Record ( " & DCount("[PolicyID]", "tblPolicies", "[linkID]='" & Nz(Me.linkID, "") & "'") & " Exists Records "
 
 Else
 Me.txtCounter.Value = "Record " & Me.CurrentRecord & " Of " & DCount("[PolicyID]", "tblPolicies", "[linkID]='" & Nz(Me.linkID, "") & "'")
 End If

כמובן שתשנו את ה-Dcount לטבלה הרלוונטית עבורכם.

 

מקור להרחבה ושיטות נוספות : http://www.fontstuff.com/mailbag/qaccess04.htm

 

בדיקה אם שאילתא קיימת, ומחיקת שאילתא דרך VBA ב- Access

ב- Access פעמים מסויימות צריך ליצור שאילתא תוך כדי ריצה

למשל כאשר רוצים ליצור שאילתת Pivot / Transpose  מותאמת למצב מסוים.

להלן 2 פונקציות Access VBA שמטפלות בשאילתות.

בדיקה אם שאילתא קיימת

 

Public Function isQueryExists(qryName As String) As Boolean

    On Error GoTo ErrorHandel


 Dim db As Database
 Dim qry As QueryDef
 Dim I As Integer
 Set db = CurrentDb()
 isQueryExists = False
 
 
 For Each qry In db.QueryDefs
               If qry.Name = qryName Then
                    isQueryExists = True
                    Exit Function
               End If
          Next qry

ExitHere:
    Exit Function
ErrorHandel:
    Err.Clear
    isQueryExists = False
    Resume ExitHere
End Function

מחיקת שאילתא

Public Sub DeleteQuery(qryName As String)
On Error Resume Next
    

    If isQueryExists(qryName) Then
        DoCmd.DeleteObject acQuery, qryName
        DoEvents
    End If

If Err.Number <> 0 Then Err.Clear
End Sub

יצירת טבלה זמנית ב-Access באמצעות VBA ומילוי שלה מתוך Recordset

לפעמים בשימוש ב-Access צריך להשתמש בטבלה זמנית.

ולפעמים הטבלה הזמנית צריכה להיות מבוססת על Recordset ADO

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

להלן המודול, ללא יותר מדי הסברים,

בקצרה – שולחים אליו רקורדסט ADO קיים, ואת השם הרצוי של הטבלה שתיווצר, והטבלה נוצרת מייד.

תוך כדי יצירת הטבלה, הפרוצדורה בודקת את השדות השונים, והגדרות השדות עוברות המרה מהפורמט של ADO אל הפורמט של Access .

 

Public Enum ETempTableActions
    CreateNewTableAndFillIt = 1
    OnlyFillExistsTable = 2
End Enum

Public Sub CreateTempLocalTable(tblName As String, ByRef rec As Object)
'                                                           פרוצדורה שיוצרת טבלה מקומית זמנית
'                                                                  על סמך רקורדסט שהועבר אליה
'                                         בהתחלה בודקים אם הטבלה קיימת ואם כן ננסה למחוק אותה
'                                                      אם היא נעולה, אז נמחק רק את תוכן הטבלה
'                                          במידה ומחקנו את הטבלה, ניצור אותה מחדש + נמלא אותה
'                                                 במידה ורק רוקנו את תוכנה, אז נמלא אותה מחדש
    On Error GoTo Error_Handel
      
    Dim dbs As Database, tdfNew As TableDef, fldTemp As Field, rst As DAO.Recordset, DAOfld As Variant, fld As Object, Proccess As Integer
    
    Set dbs = CurrentDb
    
    If isTableExists(tblName) Then
        
        If DeleteTable(tblName) = True Then
            Proccess = ETempTableActions.CreateNewTableAndFillIt
        Else
            Proccess = ETempTableActions.OnlyFillExistsTable
        End If
    
    Else
        
        Proccess = ETempTableActions.CreateNewTableAndFillIt
    
    End If
    
    Select Case Proccess
        
        Case ETempTableActions.CreateNewTableAndFillIt
            
            Call CreateNewTable(dbs, tdfNew, rec, tblName)
            Call InsertRecToTable(rec, tblName)
        
        Case ETempTableActions.OnlyFillExistsTable
            
            Call InsertRecToTable(rec, tblName)
    
    End Select
             
ExitHere:
    
    Exit Sub
Error_Handel:
    Err.Clear
    Resume ExitHere
End Sub
Private Sub InsertRecToTable(ByRef rec As Object, tblName As String)
    
    On Error Resume Next

    Dim rst As Recordset, DAOfld As Variant

    If Not rec.EOF Then
        rec.MoveFirst
        Set rst = CurrentDb.OpenRecordset(tblName) 'פותח עוד רקורדסט שיכיל את  הטבלה החדשה שנוצרה
        
        Do While Not rec.EOF
            
            rst.AddNew
            
            For Each DAOfld In rst.fields
                
                If DAOfld.Type = dbBoolean Then
                    rst.fields(DAOfld.Name).Value = CBool(rec.fields(DAOfld.Name).Value)
                Else
                    rst.fields(DAOfld.Name).Value = rec.fields(DAOfld.Name).Value
                End If
            
            Next DAOfld
            
            rst.Update
            
            rec.MoveNext
         Loop
    End If
    
    rst.Close
    Set rst = Nothing

    If Err.Number <> 0 Then Err.Clear

End Sub
Public Function isTableExists(tblName As String) As Boolean
'                       בודק אם טבלה בשם הזה קיימת
'                                מחזיר ערך בוליאני
    On Error GoTo Error_Handel
    Dim db As Database, tbl As TableDef, I As Integer
    Set db = CurrentDb()
    isTableExists = False
        
    For Each tbl In db.TableDefs
        If tbl.Name = tblName Then
             isTableExists = True
             Exit Function
        End If
     Next tbl

ExitHere:
    Exit Function
Error_Handel:
    Err.Clear
    isTableExists = False
    Resume ExitHere
End Function

Private Sub CreateNewTable(ByRef dbs As Object, ByRef tdfNew As TableDef, ByRef rec As Object, tblName As String)
    
    On Error GoTo Error_Handel
    
    Dim fldType As Variant, fld As Object, fldTemp As Field
    
    Set tdfNew = dbs.CreateTableDef(tblName)
    Set fld = CreateObject("ADOX.Column")   'CreateObject("ADODB.Field")
    
    With tdfNew
          ' Create fields and append them to the new TableDef
          ' object. This must be done before appending the
          ' TableDef object to the TableDefs collection of the
          ' database.
          For Each fld In rec.fields
                
                Select Case fld.Type
                    Case 202
                        fldType = dbText
                    Case 201
                        fldType = dbMemo
                    Case 10
                        fldType = dbText
                    Case 135
                        fldType = dbDate
                    Case 11
                        fldType = dbBoolean
                    Case Else
                        fldType = fld.Type
                End Select
        
                Set fldTemp = tdfNew.CreateField(fld.Name, fldType)
                If (fldType = dbText Or fldType = dbMemo) Then fldTemp.AllowZeroLength = True
                
                tdfNew.fields.Append fldTemp
            
            Next fld
    
    End With

    dbs.TableDefs.Append tdfNew
    dbs.TableDefs.Refresh
    DoEvents

ExitHere:
    Exit Sub
Error_Handel:
    Err.Clear
    Resume ExitHere
End Sub

Public Function DeleteTable(tblName As String) As Boolean
     
     On Error Resume Next
     Err.Clear
     Dim DeleteSql As String
     
     DoCmd.DeleteObject acTable, tblName
    
     DoEvents
'           לפעמים הטבלה נעולה ותתקבל במקרה הזה תקלה
        '                  במקרה כזה, נרוקן את הטבלה מרשומות
        '      ונמשיך מייד למילוי הטבלה , בלי ליצור אותה מחדש
     If Err.Number <> 0 Then '= 3211 Or Err.Number = 3021 Then
            
            DeleteSql = "DELETE * FROM " & tblName & ";"
                
                DoCmd.SetWarnings False
                DoCmd.RunSQL DeleteSql
                DoCmd.SetWarnings True
            
            DoEvents
            Err.Clear
            DeleteTable = False
     Else
            DeleteTable = True
     End If
   
End Function

לפתוח אוביקט ACCESS בלי להציג את חלון ה-Access כלל

נניח אם רוצים לפתוח ב-OLE אוביקט של ACCESS, שיפעיל משהו
אבל בלי להציג כלום על המסך

יש לעשות כך:
1. לבטל את האפשרות "מסך בפתיחה…"
אם רוצים פעילות מסויימת בפתיחה – יש לשים אותה בתוך *מאקרו* שיקרא בשם השמור AutoExec
אפשר דרך המאקרו לקרוא ל*פונקציות* VBA דרך הפקודה RUNCODE
רק לפונקציות, לא לפרוצדורות.
אם רוצים לקרוא לפרוצדורה
אז שהמאקרו יקרא לפונקציה באמצעות פקודת RUNCODE
והפונקציה תקרא לפרוצדורה.

2. בהפעלת האוביקט יש לדאוג ל-2 פרמטרים הבאים USERCONZTROL + VISIBLE
וזהו גם הקוד המלא…

Dim acs As Object
Set acs = CreateObject("Access.Application")
acs.Application.UserControl = False
acs.Application.Visible = False
acs.OpenCurrentDatabase "C:MyFolderMyDB.accdb"  
acs.Close

לפתוח מסך של Access בלי להציג את הרקע של Access Application – באמצעות Windows API

הערה : לא מתאים למתכנתים מתחילים.
מצריך ידע טוב ב-VBA, כולל קומפליציה מותנית, ו-Windows API.
הערה חשובה 2 : כדי לפתוח את אקסס בלי להפעיל את מה שאמור להיות מופעל בהתחלה, פותחים אותו ומחזיקים את ה- Shift לחוץ (אלא אם כן מנעתם את זה עם סקריפט ואז אתם בבעיה).

נניח ורוצים לפתוח עם VBA
את אקסס מתוך אקסל

בצורה "נקיה"
בלי להציג את מסך הרקע של אקסס.

הפתרון שלי מבוסס על הפתרון של KNK שמופיע כאן.
והוא ביסס את הפתרון על פתרון של Dev Ashish/
ואני שיכללתי את זה טיפ טיפ.

היתרון בפתרון שלי הוא שהוא … כתוב בעברית 🙂
וגם כן תפרתי היטב את החלקים שקשורים ל-VBA7 ול-Win 64

אז ככה :
1. באפליקציה האקסס אתה חייב :
1.1 להגדיר טופס שעולה עם התחלת התוכנה
1.2 לבטל את "חלונית הניווט"
1.3 לבטל את "הצג לשוניות מסמך"

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

בטופס הזה, תגדיר טיימר , נניח של 1000 מיליסקנד
ותוסיף 2 אירועים
באירוע של OnLoad אתה מסתיר את הריבון

DoCmd.ShowToolbar "Ribbon", acToolbarNo

ובאירוע של הטיימר ,
אתה עושה 3 דברים בסדר הבא :
1. קורא ל-Windows API כדי שיסתיר את החלון של האקסס
2. סוגר את הטופס הנוכחי
3. פותח את הטופס העיקרי שלך.

בנוסף חשוב לציין
כל הטפסים, הדוחות וכו', חייבים להיות
1. מודאלים
2. מוקפצים

הדוחות – חשוב לפתוח ב-Maximaize
וחשוב להגדיר כפתור בטופס הראשי שלך עם אפשרות יציאה Application.quit

אחרי כל זה
המודול שמטפל בהסתרה מכיל את הקוד הבא :

Option Compare Database
Option Explicit
'I copy from here
'http://www3.telus.net/geo123/HideAccessShell2K7.html
'http://www.utteraccess.com/forum/Forms-Access-Background-t1958468.html

Global Const SW_HIDE = 0
Global Const SW_SHOWNORMAL = 1
Global Const SW_SHOWMINIMIZED = 2
Global Const SW_SHOWMAXIMIZED = 3

#If Win64 Then
    Private Declare PtrSafe Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hWnd As LongPtr, ByVal nCmdShow As LongPtr) As LongPtr
#Else
    Private Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
#End If
    

Function DoAccessWindow(nCmdShow As Long)
' This function can minimize Access behind the scenes.

'Usage Examples
'Maximize window:
'       ?DoAccessWindow(SW_SHOWMAXIMIZED)
'Minimize window:
'       ?DoAccessWindow(SW_SHOWMINIMIZED)
'Hide window:
'       ?DoAccessWindow(SW_HIDE)
'Normal window:
'       ?DoAccessWindow(SW_SHOWNORMAL)
'

Dim loX  As LongPtr
Dim loform As Form
    On Error Resume Next
    Set loform = Screen.ActiveForm
    If Err <> 0 Then 'no Activeform
      If nCmdShow = SW_HIDE Then
        MsgBox "Cannot hide Access unless a form is on screen"
      Else
        loX = apiShowWindow(hWndAccessApp, nCmdShow)
        Err.Clear
      End If
    Else
        If nCmdShow = SW_SHOWMINIMIZED And loform.Modal = True Then
            MsgBox "Cannot minimize Access with " & (loform.Caption + " ") & "form on screen"
        ElseIf nCmdShow = SW_HIDE And loform.PopUp <> True Then
            MsgBox "Cannot hide Access with " & (loform.Caption + " ") & "form on screen"
        Else
            loX = apiShowWindow(hWndAccessApp, nCmdShow)
        End If
    End If
    DoAccessWindow = (loX <> 0)
End Function



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

עכשיו לחלק המעניין.
בפתרון של KNK מופיע גם מודול של Shell שמאפשר להשתמש ב-Windows API כדי להפעיל עוד מופעים (Instances ) של Access .
אני לקחתי את זה חצי צעד קדימה ומתוך אקסל , פתחתי כבר את האוביקט אקסס
ביררתי מה מספר החלון שלו מבחינת Windows API
ועם המספר הזה, השתמשתי במודול Shell של Windows API

בבקשה ה-VBA, מתוך אקסל , מכילה פרוצדורה אחת ופונקציה אחת
את הפונקציה מבחינת סדר הייתי ממליץ לאחסן במודול נפרד.

First Sub

sub FirstSub()
Dim acs As Object, myHWD As LongPtr, yReply As LongPtr
Set acs = CreateObject("Access.Application")
acs.Application.Visible = True
myHWD = acs.Application.hWndAccessApp
yReply = fHandleFile("C:YourDB.accdb", WIN_NORMAL, myHWD)
End Sub

Seconed Function

Option Explicit

'************ Code Start **********
'This code was originally written by Dev Ashish.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
#If VBA7 Then
Private Declare PtrSafe Function apiShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" _
    (ByVal hWnd As LongPtr, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As LongPtr) _
    As LongPtr


#Else
Private Declare Function apiShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" _
    (ByVal hWnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) _
    As Long
#End If
'***App Window Constants***
Public Const WIN_NORMAL = 1         'Open Normal
Public Const WIN_MAX = 2            'Open Maximized
Public Const WIN_MIN = 3            'Open Minimized

'***Error Codes***
Private Const ERROR_SUCCESS = 32&
Private Const ERROR_NO_ASSOC = 31&
Private Const ERROR_OUT_OF_MEM = 0&
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&

'***************Usage Examples***********************
'Open a folder:     ?fHandleFile("C:TEMP",WIN_NORMAL)
'Call Email app:    ?fHandleFile("mailto:dash10@hotmail.com",WIN_NORMAL)
'Open URL:          ?fHandleFile("http://home.att.net/~dashish", WIN_NORMAL)
'Handle Unknown extensions (call Open With Dialog):
'                   ?fHandleFile("C:TEMPTestThis",Win_Normal)
'Start Access instance:
'                   ?fHandleFile("I:mdbsCodeNStuff.mdb", Win_NORMAL)
'****************************************************

Function fHandleFile(stFile As String, lShowHow As Long, hWndAccessApp As LongPtr)
Dim lRet As LongPtr, varTaskID As Variant
Dim stRet As String
    'First try ShellExecute
    lRet = apiShellExecute(hWndAccessApp, vbNullString, _
            stFile, vbNullString, vbNullString, lShowHow)
            
    If lRet > ERROR_SUCCESS Then
        stRet = vbNullString
        lRet = -1
    Else
        Select Case lRet
            Case ERROR_NO_ASSOC:
                'Try the OpenWith dialog
                varTaskID = Shell("rundll32.exe shell32.dll,OpenAs_RunDLL " _
                        & stFile, WIN_NORMAL)
                lRet = (varTaskID <> 0)
            Case ERROR_OUT_OF_MEM:
                stRet = "Error: Out of Memory/Resources. Couldn't Execute!"
            Case ERROR_FILE_NOT_FOUND:
                stRet = "Error: File not found.  Couldn't Execute!"
            Case ERROR_PATH_NOT_FOUND:
                stRet = "Error: Path not found. Couldn't Execute!"
            Case ERROR_BAD_FORMAT:
                stRet = "Error:  Bad File Format. Couldn't Execute!"
            Case Else:
        End Select
    End If
    fHandleFile = lRet & _
                IIf(stRet = "", vbNullString, ", " & stRet)
End Function
'************ Code End **********