title image


Smiley Re: sicherung von mappenübergreifenden spezifischen codes?


Option Explicit



Private Type BrowseInfo

     hwndOwner As Long

     pIDLRoot As Long

     pszDisplayName As Long

     lpszTitle As Long

     ulFlags As Long

     lpfnCallback As Long

     lParam As Long

     iImage As Long

End Type



Private Const BIF_RETURNONLYFSDIRS = 1

Private Const MAX_PATH = 260



Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)

Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long

Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long



' Tabellen und dokumentencode wird mit der Extention cls als Klassenmodul ausgegeben

' Zugriff auf das Visualbasicproject vertrauen muss in den Sicherheitseinstellungen gesetzt sein

' Der Speicherort kann gewählt werden



Public Sub Exportiere_alle_Module()

Dim pf$, vb As Object

  pf = get_path("Zielverzeichnis für die Module wählen")

  If pf = vbNullString Then Exit Sub

  

  With Application.VBE.ActiveVBProject

    

    For Each vb In .VBComponents

        Select Case vb.Type

            Case 100: vb.Export pf & "\" & vb.Name & ".cls"

            Case 2: vb.Export pf & "\" & vb.Name & ".cls"

            Case 3: vb.Export pf & "\" & vb.Name & ".frm"

            Case 1: vb.Export pf & "\" & vb.Name & ".bas"

        End Select

    Next

    MsgBox "Alles raus ... "

  End With

  

End Sub







Private Function BrowseForFolder(hwndOwner As Long, sPrompt As String) As String

     

Dim iNull As Integer

Dim lpIDList As Long

Dim lResult As Long

Dim sPath As String

Dim udtBI As BrowseInfo



     With udtBI

        .hwndOwner = hwndOwner

        .lpszTitle = lstrcat(sPrompt, "")

        .ulFlags = BIF_RETURNONLYFSDIRS

     End With



     lpIDList = SHBrowseForFolder(udtBI)

     

     If lpIDList Then

        sPath = String$(MAX_PATH, 0)

        lResult = SHGetPathFromIDList(lpIDList, sPath)

        Call CoTaskMemFree(lpIDList)

        iNull = InStr(sPath, vbNullChar)

        If iNull Then sPath = Left$(sPath, iNull - 1)

     End If



     BrowseForFolder = sPath



End Function





Public Function get_path(meldung$) As String

    get_path = BrowseForFolder(CLng(0), meldung)

End Function







 Code eingefügt mit Syntaxhighlighter 1.16

Knofi So wie wir heute arbeiten, werden morgen die Beamten leben ...

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: