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

yits

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

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

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

clickone

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

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

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

yits

@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 יגעת ומצאת תאמין.