אקסס VBA עם הרשאות מנהל?



  • אני מעוניין להתקין פונט (במקרה שהוא לא קיים) ואני מקבל שגיאה של Access is denied (נחסמה גישה).

    האם יש דרך לפנות לAPI במחשב עם הרשאות מנהל?

    או שאולי הדרך הטובה לכתוב את זה ל batch ולהריץ אותו כמנהל? (לזה מצאתי API עם אפשרות של "RunAs").
    @clickone



  • @yits אמר באקסס VBA עם הרשאות מנהל?:

    או שאולי הדרך הטובה לכתוב את זה ל batch ולהריץ אותו כמנהל? (לזה מצאתי API עם אפשרות של "RunAs").

    זה היותר נורמלי...
    או שתעשה תוכנת התקנה לתוכנה שלך



  • @clickone
    לאחר מאמצים מרובים נמצא הפתרון והכל ב VBA

    0_1518658389338_Barcode.rar

    Option Compare Database
    
    Public Declare PtrSafe Function ShellExecute 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
    Const SW_SHOWNORMAL = 1
    Const SW_SHOWHIDE = 0
    
    'בדיקת קבצים
    'fileExists(Environ("SystemRoot") & "\fonts","ean-13")
    Function fileExists(s_directory As String, s_fileName As String) As Boolean
    
      Dim obj_fso As Object, obj_dir As Object, obj_file As Object
      Dim ret As Boolean
       Set obj_fso = CreateObject("Scripting.FileSystemObject")
       Set obj_dir = obj_fso.GetFolder(s_directory)
       ret = False
       For Each obj_file In obj_dir.Files
         If obj_fso.fileExists(s_directory & "\" & s_fileName) = True Then
            ret = True
            Exit For
          End If
       Next
    
       Set obj_fso = Nothing
       Set obj_dir = Nothing
       fileExists = ret
    
     End Function
    'הרצה של שורת הפקודה
    'AddFont "ean-13.ttf", CurrentProject.Path
    Function AddFont(sFontName As String, sSourceFolder As String)
    Dim sSystemFontFolder As String
    Dim cmdCopy As String, cmdAddReg As String, cmdPause As String, command As String
    Dim sRegFullKey As String
    
    sSystemFontFolder = """" & Environ("SystemRoot") & "\FONTS\" & """"
    
    cmdCopy = "/c copy"
    cmdCopy = cmdCopy & " " & """" & sSourceFolder & "\" & sFontName & """"
    cmdCopy = cmdCopy & " " & sSystemFontFolder
    sRegFullKey = " """ & "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts" & """"
    cmdAddReg = "reg add" & sRegFullKey
    cmdAddReg = cmdAddReg & " /v " & """" & Left$(sFontName, Len(sFontName) - 4) & " (TrueType)" & """"
    cmdAddReg = cmdAddReg & " /t REG_SZ"
    cmdAddReg = cmdAddReg & " /d " & sFontName & " /f"
    cmdPause = " & pause"
    command = cmdCopy & " & " & cmdAddReg & cmdPause
    
        ShellExecute 0, "runas", "cmd", command, "C:\", SW_SHOWHIDE
    End Function
    
    
    


  • @yits יגעת ומצאת תאמין.


 

בא תתחבר לדף היומי!