Systémové proměnné a složky

Jak naznačuje titulek, podíváme se na dva pojmy – systémové proměnné a složky. Pro první z nich je klíčové slovíčko Environ (Environment), konkrétně funkce VBA Environ, API funkce GetEnvironmentVariableA, WMI dotaz Select * from Win32_Environment aj.

K těmto funkcím obracejte pozornost, pokud potřebujete vracet informace o procesoru, jméno aktuálně přihlášeného uživatele nebo název počítače (WMI jde více do hloubky, především v otázce práv, registrů nebo třeba hardware).

Sub PocitacUzivatelVBA()
   
    MsgBox Environ$("COMPUTERNAME")
    MsgBox Environ$("USERNAME")

End Sub

Pro úplnost dodávám ekvivaletní výpis kódu s API funkcemi.

Public Declare Function GetComputerNameA Lib "kernel32" (ByVal lpBuffer As _
    String, nSize As Long) As Long
Public Declare Function GetUserNameA Lib "advapi32" (ByVal lpBuffer As String, _
    nSize As Long) As Long

Sub TestPrihlasenyUzivatel()
    MsgBox epfPocitac
    MsgBox epfUzivatel
End Sub

Public Function epfPocitac() As String
    Dim strPocitac As String * 255
    Call GetComputerNameA(strPocitac, 255)
    epfPocitac = Left$(strPocitac, InStr(strPocitac, Chr$(0)) - 1)
End Function

Public Function epfUzivatel() As String
    Dim strUzivatel As String * 255
    Call GetUserNameA(strUzivatel, 255)
    epfUzivatel = Left$(strUzivatel, InStr(strUzivatel, Chr$(0)) - 1)
End Function

Horší je to už v případě zjišťování systémových složek. Teoreticky se kupříkladu ke složce dokumentů aktuálního uživatele dostanete přes Environ$(„USERPROFILE“), ke kterému přilepíte řetězec „\Documents“ (platí i jako odkaz pro české Dokumenty). V minulosti se ale název složky i cesta k ní měnila (jak v anglické, tak české verzi), a tak je výsledek nejistý. Rozumně lze získat ještě tak cestu ke složce s odkládacími soubory (TEMP). Tím to ovšem končí.

Pro systémové složky sáhněte buď do VBScriptu a jeho WSH (Windows Script Host), potažmo modelu FSO (File System Objects), nebo použijte API funkce (SHGetFolderPathA).

'http://technet.microsoft.com/en-us/library/ee176604.aspx

'moje Plocha (Desktop)
Private Const CSIDL_DESKTOP As Long = &H0
'moje Dokumenty (Documents)
Private Const CSIDL_PERSONAL As Long = &H5

Private Declare Sub SHGetFolderPath Lib "shell32" Alias "SHGetFolderPathA" _
    (ByVal Hwnd As Long, ByVal csidl As Long, ByVal hToken As Long, ByVal dwFlags _
    As Long, ByVal pszPath As String)

Sub SpecialniSlozkyAPI()
   
    Dim strSlozka As String
   
    strSlozka = Space(255)

    'složka dokumentů aktuálního uživatele (bez zpětného lomítka na konci):
    SHGetFolderPath Application.Hwnd, CSIDL_PERSONAL, 0&, 0&, strSlozka
   
    'zobrazení zprávy:
    MsgBox Trim(strSlozka)
   
    'složka plochy aktuálního uživatele (bez zpětného lomítka na konci):
    SHGetFolderPath Application.Hwnd, CSIDL_DESKTOP, 0&, 0&, strSlozka
   
    'zobrazení zprávy:
    MsgBox Trim(strSlozka)
   
End Sub

Sub SpecialniSlozkyWSH()

    Dim wshShell As Object

    'objekt WSH
    Set wshShell = CreateObject("WScript.Shell")
   
    'složka dokumentů aktuálního uživatele (bez zpětného lomítka na konci):
    strCestaDokumenty = wshShell.SpecialFolders("MyDocuments")
   
    'složka plochy aktuálního uživatele (bez zpětného lomítka na konci):
    strCestaPlocha = wshShell.SpecialFolders("Desktop")

End Sub

Pozn. Existuje ještě objekt Shell.Application, který by měl mít také přístup k systémovým složkám prostřednictvím „NameSpace“. Bohužel v mém případě kód není funkční.

Sub DialogShell()

    'Windows 7, 64 bit
    'nefunkční

    'objekt Shell
    Set objShell = CreateObject("Shell.Application")

    'složka dokumentů
    objShell.NameSpace (5)

End Sub

Pokud se cesta ke složce odvíjí od aktuálního sešitu (sešitu se spouštěcí procedurou), pak se obraťte na objekty ActiveWorkbook (ThisWorkbook) a jejich vlastnost .Path.

Jestliže má cesta vazbu na instalaci Excelu (Office), podívejte se na vybrané vlastnosti objektu Application (.Path, .Startup.Path, .AltStartup.Path, .Templates.Path, .Library.Path, …).

Většina cest ke složkám, které obdržíte, nebude obsahovat na konci zpětné lomítko. To je nutné pro některé další nástroje stejně jako pro následné připojení názvu souboru. O jeho programové doplnění se může postarat níže uvedený kus kódu (nedojde ke zdvojení v případě existence, ve výpisu varianta s užitím API funkce i bez ní).

Private Declare Function PathAddBackslash Lib "shlwapi.dll" Alias _
    "PathAddBackslashA" (ByVal pszPath As String) As Long

Sub TestZpetneLomitkoAPI()
    Dim strCestaLomitko As String
    strCestaLomitko = CestaZpetneLomitko("c:\Windows")
End Sub

Function CestaZpetneLomitko(ByVal Retezec As String)
    Retezec = Retezec + String(255, 0)
    PathAddBackslash (Retezec)
    CestaZpetneLomitko = Replace(Retezec, Chr(0), vbNullString)
End Function

Sub TestZpetneLomitkoBezAPI()
    Dim strCesta As String
    Dim strCestaLomitko As String
    strCesta = "c:\Windows"
    strCestaLomitko = IIf(Right$(strCesta, 1) = "", strCesta, strCesta & "")
End Sub
Klikni a stahuj!