Baumstruktur in einer VB - Form darstellen

Para · 2005-07-12T21:31:34+00:00

Liebe Forumer! Ich habe eine Frage an euch: Ich möchte eine interaktive Baumstruktur in einer User-Form einblenden lassen! Wie kann ich dass am einfachsten machen...? Wäre dankbar für Response Para

Hi,
gehn tut allse, aber ist das einfach?
Code des Userforms:
Option Explicit

Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
    ByVal lpPath As String) As Long

Private strDestinationPath As String

Private Sub CommandButton1_Click()
    Me.Hide
End Sub

Private Sub CommandButton2_Click()
    Dim strFoldername As String
    If strDestinationPath <> "" Then
        strFoldername = fncName("Bitte geben sie den Namen des Ordners ein.", _
            strDestinationPath, "", 16)
        If strFoldername <> "" Then
            MakeSureDirectoryPathExists strDestinationPath & "\" & strFoldername & "\"
            Call ImageCombo1_Click
        End If
    Else
        MsgBox "Kein Ordner ausgewählt.", 48, "Hinweis"
    End If
End Sub

Private Sub CommandButton3_Click()
    Dim intIndex As Integer, strZIPfilename As String, lngReturn As Long
    Dim typFilename As ZIPnames
    strDestinationPath = Trim$(strDestinationPath)
    If strDestinationPath <> "" Then
        Me.MousePointer = 11
        If UserForm1.OptionButton1 Then 'allle in eins
            strZIPfilename = fncName("Bitte geben sie den Namen des ZIP-Ordners ein.", _
                strDestinationPath, ".zip", 0)
            If strZIPfilename <> "" Then
                strZIPfilename = strZIPfilename & ".zip"
                For intIndex = 1 To UBound(strFileArray)
                    typFilename.s(intIndex - 1) = strFileArray(intIndex)
                Next
                lngReturn = VBZip(intIndex - 1, strZIPfilename, typFilename, _
                    0, 0, 0, 0, strDestinationPath)
                If lngReturn <> 0 Then
                    MsgBox "Fehler Zip: Return Code " & CStr(lngReturn), 16, "Fehler"
                    Me.MousePointer = 0
                    Exit Sub
                End If
            Else
                Me.MousePointer = 0
                Exit Sub
            End If
        Else
            For intIndex = 1 To UBound(strFileArray)
                typFilename.s(0) = strFileArray(intIndex)
                lngReturn = VBZip(1, Dir$(strFileArray(intIndex)) & ".zip", _
                    typFilename, 0, 0, 0, 0, strDestinationPath)
                If lngReturn <> 0 Then
                    MsgBox "Fehler Zip: Return Code " & CStr(lngReturn), 16, "Fehler"
                    Me.MousePointer = 0
                    Exit Sub
                End If
            Next
            Set myFileSystemObject = Nothing
        End If
        Me.MousePointer = 0
        On Error Resume Next
        If UserForm1.CheckBox1 Then
            For intIndex = 1 To UBound(strFileArray)
                Kill strFileArray(intIndex)
            Next
        End If
        With Me
            .Hide
            .TreeView1.Nodes.Clear
            .ImageCombo1.Text = ""
        End With
        With UserForm1
            .ListView1.ListItems.Clear
            .TreeView1.Nodes.Clear
            .ImageCombo1.Text = ""
            .CheckBox1.Value = False
            .OptionButton1.Value = True
            .Show
        End With
    Else
        MsgBox "Kein Ordner ausgewählt.", 48, "Hinweis"
    End If
End Sub

Private Sub CommandButton4_Click()
    Me.Hide
    UserForm1.Show
End Sub

Private Sub ImageCombo1_Click()
    Dim strFolderPath As String
    If ImageCombo1.Text <> "" Then
        strDestinationPath = ""
        TreeView1.Nodes.Clear
        Set myFileSystemObject = New FileSystemObject
        Set myDrive = myFileSystemObject.GetDrive(Left$(ImageCombo1.Text, 2))
        If myDrive.IsReady Then
            strFolderPath = myDrive.DriveLetter & ":"
            With TreeView1.Nodes
                .Add , 0, strFolderPath, strFolderPath, 1, 2
                Call prcFindFolder(strFolderPath, Me)
                If .Count > 1 Then .Item(2).EnsureVisible
            End With
        Else
            MsgBox "Laufwerk '" & myDrive.DriveLetter & "' nicht bereit." _
                & vbLf & "Bitte legen sie einen Datenträger ein.", 48, "Hinweis"
            ImageCombo1.Text = ""
        End If
    End If
    CommandButton1.SetFocus
End Sub

Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
    strDestinationPath = Node.FullPath
End Sub

Private Sub UserForm_Initialize()
    Dim intIndex As Integer
    With ImageList1.ListImages
        .Add , , Image1.Picture
        .Add , , Image2.Picture
    End With
    TreeView1.ImageList = ImageList1
    With ImageList2.ListImages
        For intIndex = 3 To 8
            .Add , , Me.Controls("Image" & CStr(intIndex)).Picture
        Next
    End With
    ImageCombo1.ImageList = ImageList2
    Set myFileSystemObject = New FileSystemObject
    For Each myDrive In myFileSystemObject.Drives
        If myDrive.IsReady Then
            ImageCombo1.ComboItems.Add , , myDrive.DriveLetter & ": " _
                & myDrive.VolumeName, myDrive.DriveType + 1
        Else
            ImageCombo1.ComboItems.Add , , myDrive.DriveLetter, myDrive.DriveType + 1
        End If
    Next
    Set myFileSystemObject = Nothing
End Sub

Code im Standardmodul 1:
Public myFileSystemObject As FileSystemObject, myDrive As Drive
Public strFileArray() As String

Code im Standardmodul 2:
Option Explicit

Sub Schaltfläche1_BeiKlick()
    UserForm1.Show
End Sub

Public Function fncName(strTitel As String, strPath As String, _
        strExtension As String, intType As Integer) As String
    Dim varInput As Variant, intIndex As Integer, bolWrongCharacter As Boolean
    Do
        varInput = Application.InputBox(strTitel, "Eingabe", Type:=2)
        If VarType(varInput) = vbBoolean And varInput = False Then Exit Do
        varInput = Trim(varInput)
        If varInput <> "" Then
            For intIndex = 1 To Len(varInput)
                If InStr(1, "/\<>*?|:;" & Chr(34), Mid$(varInput, intIndex, 1)) <> 0 Then _
                    bolWrongCharacter = True: Exit For
            Next
            If Not bolWrongCharacter Then
                If Dir(strPath & "\" & varInput & strExtension, intType) = "" Then
                    fncName = CStr(varInput)
                    Exit Do
                Else
                    MsgBox "Dieser Name existiert schon.", 48, "Hinweis"
                End If
            Else
                MsgBox "Der Name enthält unzulässige Zeichen." & vbLf & _
                    "Nicht zugelassen sind / \ < > * ? | : ;"
                bolWrongCharacter = False
            End If
        Else
            MsgBox "Bitte geben sie einen Namen ein.", 48, "Hinweis"
        End If
    Loop
End Function

Code im Standardmodul 3:
Option Explicit

Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" ( _
    ByVal lpFileName As String, _
    lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" ( _
    ByVal hFindFile As Long, _
    lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" ( _
    ByVal hFindFile As Long) As Long

Private Enum FILE_ATTRIBUTE
    MAX_PATH = 260
    INVALID_HANDLE_VALUE = -1
    FILE_ATTRIBUTE_ARCHIVE = &H20
    FILE_ATTRIBUTE_DIRECTORY = &H10
    FILE_ATTRIBUTE_HIDDEN = &H2
    FILE_ATTRIBUTE_NORMAL = &H80
    FILE_ATTRIBUTE_READONLY = &H1
    FILE_ATTRIBUTE_SYSTEM = &H4
    FILE_ATTRIBUTE_TEMPORARY = &H100
End Enum

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type

Public Sub prcFindFolder(ByVal strFolderPath As String, myForm As UserForm)
    Dim WFD As WIN32_FIND_DATA, lngSearch As Long, strDirName As String
    lngSearch = FindFirstFile(strFolderPath & "\*", WFD)
    If lngSearch <> INVALID_HANDLE_VALUE Then
        Do
            If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
                strDirName = Left$(WFD.cFileName, InStr(WFD.cFileName, Chr(0)) - 1)
                If (strDirName <> ".") And (strDirName <> "..") Then
                    If InStr(1, ",16,17,8208,8209,8240,8241,", "," & _
                        CStr(WFD.dwFileAttributes) & ",") <> 0 Then
                        myForm.TreeView1.Nodes.Add strFolderPath, 4, _
                            strFolderPath & "\" & strDirName, strDirName, 1, 2
                        Call prcFindFolder(strFolderPath & "\" & strDirName, myForm)
                    End If
                End If
            End If
        Loop While FindNextFile(lngSearch, WFD)
        FindClose lngSearch
    End If
End Sub

Public Sub prcFindFilesInFolder(ByVal strFolderPath As String, myForm As UserForm)
    Dim WFD As WIN32_FIND_DATA, lngSearch As Long
    lngSearch = FindFirstFile(strFolderPath & "\*.*", WFD)
    If lngSearch <> INVALID_HANDLE_VALUE Then
        Do
            If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY Then
                If InStr(1, ",1,32,33,34,128,8192,8193,8194,8224,8225,8226,", _
                    "," & CStr(WFD.dwFileAttributes) & ",") <> 0 Then _
                    myForm.ListView1.ListItems.Add , , _
                    Left$(WFD.cFileName, InStr(WFD.cFileName, Chr(0)) - 1)
            End If
        Loop While FindNextFile(lngSearch, WFD)
        FindClose lngSearch
    End If
End Sub

Viel Spaß beim basteln.
Gruß
Nepumuk
Excel & VBA Beispiele

Hallo Bernd,
Da:
Option Explicit

Public Type ZIPnames
    s(0 To 999) As String
End Type

'ZPOPT is used to set options in the zip32.dll
Private Type ZPOPT
    fSuffix As Long
    fEncrypt As Long
    fSystem As Long
    fVolume As Long
    fExtra As Long
    fNoDirEntries As Long
    fExcludeDate As Long
    fIncludeDate As Long
    fVerbose As Long
    fQuiet As Long
    fCRLF_LF As Long
    fLF_CRLF As Long
    fJunkDir As Long
    fRecurse As Long
    fGrow As Long
    fForce As Long
    fMove As Long
    fDeleteEntries As Long
    fUpdate As Long
    fFreshen As Long
    fJunkSFX As Long
    fLatestTime As Long
    fComment As Long
    fOffsets As Long
    fPrivilege As Long
    fEncryption As Long
    fRepair As Long
    flevel As Byte
    date As String ' 8 bytes long
    szRootDir As String ' up to 256 bytes long
End Type

Private Type ZIPUSERFUNCTIONS
    DllPrnt As Long
    DLLPASSWORD As Long
    DLLCOMMENT As Long
    DLLSERVICE As Long
End Type

'Local declares
Dim MYOPT As ZPOPT
' Dim MYZCL As ZCL
Dim MYUSER As ZIPUSERFUNCTIONS

Private Declare Function ZpInit Lib "zip32.dll" ( _
    ByRef Zipfun As ZIPUSERFUNCTIONS) As Long ' Set Zip Callbacks
Private Declare Function ZpSetOptions Lib "zip32.dll" ( _
    ByRef Opts As ZPOPT) As Long ' Set Zip options
Private Declare Function ZpGetOptions Lib "zip32.dll" () As ZPOPT
Private Declare Function ZpArchive Lib "zip32.dll" ( _
    ByVal argc As Long, _
    ByVal funame As String, _
    ByRef argv As ZIPnames) As Long ' Real zipping action

Private Type U_CBChar
    ch(32800) As Byte
End Type

Private Type Z_CBChar
    ch(4096) As Byte
End Type

Private Type CBCh
    ch(256) As Byte
End Type

Private Type DCLIST
    ExtractOnlyNewer As Long
    SpaceToUnderscore As Long
    PromptToOverwrite As Long
    fQuiet As Long
    ncflag As Long
    ntflag As Long
    nvflag As Long
    nUflag As Long
    nzflag As Long
    ndflag As Long
    noflag As Long
    naflag As Long
    nZIflag As Long
    C_flag As Long
    fPrivilege As Long
    Zip As String
    ExtractDir As String
End Type

Private Type USERFUNCTION
    DllPrnt As Long
    DLLSND As Long
    DLLREPLACE As Long
    DLLPASSWORD As Long
    DLLMESSAGE As Long
    DLLSERVICE As Long
    TotalSizeComp As Long
    TotalSize As Long
    CompFactor As Long
    NumMembers As Long
    cchComment As Integer
End Type

Private Type UZPVER
    structlen As Long
    flag As Long
    beta As String * 10
    date As String * 20
    zlib As String * 10
    unzip(1 To 4) As Byte
    zipinfo(1 To 4) As Byte
    os2dll As Long
    windll(1 To 4) As Byte
End Type

Private Declare Function windll_unzip Lib "unzip32.dll" ( _
    ByVal ifnc As Long, _
    ByRef ifnv As ZIPnames, _
    ByVal xfnc As Long, _
    ByRef xfnv As ZIPnames, _
    dcll As DCLIST, _
    Userf As USERFUNCTION) As Long
Private Declare Sub UzpVersion2 Lib "unzip32.dll" (uzpv As UZPVER)

Dim MYDCL As DCLIST
Dim U_MYUSER As USERFUNCTION
Dim MYVER As UZPVER

Public vbzipnum As Long, vbzipmes As String
Public vbzipnam As ZIPnames
Public vbxnames As ZIPnames

Function FnPtr(ByVal lp As Long) As Long
    FnPtr = lp
End Function

Function DllPrnt(ByRef fname As Z_CBChar, ByVal AnzChars As Long) As Long
    ' Dim t&, a$
    On Error Resume Next
    ' For t = 0 To AnzChars
    ' If fname.ch(t) <> 10 Then
    ' a = a + Chr(fname.ch(t))
    ' End If
    ' Next t
    ' MsgBox Trim(a)
    DllPrnt = 0
End Function

Function DllPass(ByRef s1 As Byte, x As Long, ByRef s2 As Byte, ByRef s3 As Byte) As Long
    On Error Resume Next 'always put this in callback routines!
    ' not supported - always return 1
    DllPass = 1
End Function

' Callback for unzip32.dll
Function DllRep(ByRef fname As U_CBChar) As Long
    Dim s0$, xx As Long
    On Error Resume Next 'always put this in callback routines!
    DllRep = 100 ' 100=do not overwrite - keep asking user
    s0 = ""
    For xx = 0 To 255
        If fname.ch(xx) = 0 Then xx = 99999 Else s0 = s0 + Chr(fname.ch(xx))
    Next xx
    xx = MsgBox("Datei '" + s0 + "' überschreiben?", vbYesNoCancel Or _
        vbQuestion, "Unzip - Zieldatei bereits vorhanden")
    If xx = vbNo Then Exit Function
    If xx = vbCancel Then
        DllRep = 104 ' 104=overwrite none
        Exit Function
    End If
    DllRep = 102 ' 102=overwrite 103=overwrite all
End Function

' Callback for unzip32.dll
Sub ReceiveDllMessage(ByVal ucsize As Long, ByVal csiz As Long, _
        ByVal cfactor As Integer, ByVal mo As Integer, ByVal dy As Integer, _
        ByVal yr As Integer, ByVal hh As Integer, ByVal mm As Integer, _
        ByVal c As Byte, ByRef fname As CBCh, ByRef meth As CBCh, _
        ByVal crc As Long, ByVal fCrypt As Byte)
    Dim s0$, xx As Long
    Dim strout As String * 80
    ' always put this in callback routines!
    On Error Resume Next
    strout = Space(80)
    If vbzipnum = 0 Then
        Mid$(strout, 1, 50) = "Filename:"
        Mid$(strout, 53, 4) = "Size"
        Mid$(strout, 62, 4) = "Date"
        Mid$(strout, 71, 4) = "Time"
        vbzipmes = strout + vbCrLf
        strout = Space(80)
    End If
    s0 = ""
    For xx = 0 To 255
        If fname.ch(xx) = 0 Then xx = 99999 Else s0 = s0 & Chr$(fname.ch(xx))
    Next xx
    Mid$(strout, 1, 50) = Mid$(s0, 1, 50)
    Mid$(strout, 51, 7) = Right$(" " + Str$(ucsize), 7)
    Mid$(strout, 60, 3) = Right$(Str$(dy), 2) + "/"
    Mid$(strout, 63, 3) = Right$("0" + Trim$(Str$(mo)), 2) + "/"
    Mid$(strout, 66, 2) = Right$("0" + Trim$(Str$(yr)), 2)
    Mid$(strout, 70, 3) = Right$(Str$(hh), 2) + ":"
    Mid$(strout, 73, 2) = Right$("0" + Trim$(Str$(mm)), 2)
    ' Mid$(strout, 75, 2) = Right$(" " + Str$(cfactor), 2)
    ' Mid$(strout, 78, 8) = Right$(" " + Str$(csiz), 8)
    ' s0 = ""
    ' For xx = 0 To 255
    ' If meth.ch(xx) = 0 Then xx = 99999 Else s0 = s0 + Chr(meth.ch(xx))
    ' Next xx
    vbzipmes = vbzipmes + strout + vbCrLf
    vbzipnum = vbzipnum + 1
End Sub

' ASCIIZ to String
Function szTrim(szString As String) As String
    Dim pos As Integer, ln As Integer
    pos = InStr(szString, Chr$(0))
    ln = Len(szString)
    Select Case pos
        Case Is > 1
            szTrim = Trim(Left(szString, pos - 1))
        Case 1
            szTrim = ""
        Case Else
            szTrim = Trim(szString)
    End Select
End Function

Sub VBUnzip(fname As String, extdir As String, prom As Integer, _
        ovr As Integer, mess As Integer, dirs As Integer, numfiles As Long, numxfiles As Long)
    Dim xx As Long
    MYDCL.ExtractOnlyNewer = 0 ' 1=extract only newer
    MYDCL.SpaceToUnderscore = 0 ' 1=convert space to underscore
    MYDCL.PromptToOverwrite = prom ' 1=prompt to overwrite required
    MYDCL.fQuiet = 0 ' 2=no messages 1=less 0=all
    MYDCL.ncflag = 0 ' 1=write to stdout
    MYDCL.ntflag = 0 ' 1=test zip
    MYDCL.nvflag = mess ' 0=extract 1=list contents
    MYDCL.nUflag = 0 ' 1=extract only newer
    MYDCL.nzflag = 0 ' 1=display zip file comment
    MYDCL.ndflag = dirs ' 1=honour directories
    MYDCL.noflag = ovr ' 1=overwrite files
    MYDCL.naflag = 0 ' 1=convert CR to CRLF
    MYDCL.nZIflag = 0 ' 1=Zip Info Verbose
    MYDCL.C_flag = 0 ' 1=Case insensitivity, 0=Case Sensitivity
    MYDCL.fPrivilege = 0 ' 1=ACL 2=priv
    MYDCL.Zip = fname ' ZIP name
    MYDCL.ExtractDir = extdir ' Extraction directory, NULL if extracting
    ' to current directory
    ' Set Callback addresses
    ' Do not change
    U_MYUSER.DllPrnt = FnPtr(AddressOf DllPrnt)
    U_MYUSER.DLLSND = 0& ' not supported
    U_MYUSER.DLLREPLACE = FnPtr(AddressOf DllRep)
    U_MYUSER.DLLPASSWORD = FnPtr(AddressOf DllPass)
    U_MYUSER.DLLMESSAGE = FnPtr(AddressOf ReceiveDllMessage)
    U_MYUSER.DLLSERVICE = 0& ' not coded yet :)
    ' Set Version space
    ' Do not change
    With MYVER
        .structlen = Len(MYVER)
        .beta = Space$(9) & vbNullChar
        .date = Space$(19) & vbNullChar
        .zlib = Space$(9) & vbNullChar
    End With
    ' Get version
    Call UzpVersion2(MYVER)
    ' MsgBox "DLL Date: " & szTrim(MYVER.date)
    ' MsgBox "Zip Info: " & Hex$(MYVER.zipinfo(1)) + "." + Hex$(MYVER.zipinfo(2)) + Hex$(MYVER.zipinfo(3))
    ' MsgBox "DLL Version: " & Hex$(MYVER.windll(1)) + "." + Hex$(MYVER.windll(2)) + Hex$(MYVER.windll(3))
    ' Go for it!
    xx = windll_unzip(numfiles, vbzipnam, numxfiles, vbxnames, MYDCL, U_MYUSER)
    If xx <> 0 Then
        MsgBox "Rückgabewert von windll_unzip: " & xx, vbCritical, "Fehler in VBUnzip"
    End If
End Sub

Function DllComm(ByRef s1 As Z_CBChar) As Z_CBChar
    On Error Resume Next
    s1.ch(0) = vbNullString
    DllComm = s1
End Function

Public Function VBZip(argc As Integer, zipname As String, _
        mynames As ZIPnames, junk As Integer, recurse As Integer, _
        updat As Integer, freshen As Integer, basename As String) As Long
    On Error Resume Next
    MYUSER.DllPrnt = FnPtr(AddressOf DllPrnt)
    MYUSER.DLLPASSWORD = FnPtr(AddressOf DllPass)
    MYUSER.DLLCOMMENT = FnPtr(AddressOf DllComm)
    MYUSER.DLLSERVICE = 0&
    ZpInit MYUSER
    MYOPT.fSuffix = 0 ' include suffixes (not yet implemented)
    MYOPT.fEncrypt = 0 ' 1 if encryption wanted
    MYOPT.fSystem = 0 ' 1 to include system/hidden files
    MYOPT.fVolume = 0 ' 1 if storing volume label
    MYOPT.fExtra = 0 ' 1 if including extra attributes
    MYOPT.fNoDirEntries = 0 ' 1 if ignoring directory entries
    MYOPT.fExcludeDate = 0 ' 1 if excluding files earlier than a specified date
    MYOPT.fIncludeDate = 0 ' 1 if including files earlier than a specified date
    MYOPT.fVerbose = 0 ' 1 if full messages wanted
    MYOPT.fQuiet = 0 ' 1 if minimum messages wanted
    MYOPT.fCRLF_LF = 0 ' 1 if translate CR/LF to LF
    MYOPT.fLF_CRLF = 0 ' 1 if translate LF to CR/LF
    MYOPT.fJunkDir = junk ' 1 if junking directory names
    MYOPT.fRecurse = recurse ' 1 if recursing into subdirectories
    MYOPT.fGrow = 0 ' 1 if allow appending to zip file
    MYOPT.fForce = 0 ' 1 if making entries using DOS names
    MYOPT.fMove = 0 ' 1 if deleting files added or updated
    MYOPT.fDeleteEntries = 0 ' 1 if files passed have to be deleted
    MYOPT.fUpdate = updat ' 1 if updating zip file--overwrite only if newer
    MYOPT.fFreshen = freshen ' 1 if freshening zip file--overwrite only
    MYOPT.fJunkSFX = 0 ' 1 if junking sfx prefix
    MYOPT.fLatestTime = 0 ' 1 if setting zip file time to time of latest file in archive
    MYOPT.fComment = 0 ' 1 if putting comment in zip file
    MYOPT.fOffsets = 0 ' 1 if updating archive offsets for sfx Files
    MYOPT.fPrivilege = 0 ' 1 if not saving privelages
    MYOPT.fEncryption = 0 'Read only property!
    MYOPT.fRepair = 0 ' 1=> fix archive, 2=> try harder to fix
    MYOPT.flevel = 0 ' compression level - should be 0!!!
    MYOPT.date = Format(date, "mm/dd/yy") ' US Date
    MYOPT.szRootDir = basename 'Destinationfolder
    ChDir (basename)
    ZpSetOptions MYOPT
    VBZip = ZpArchive(argc, zipname, mynames)
End Function

Du benötigst natürlich noch die DLL's. Im Userform eine Imagecombo, ein Treeview, ein Listview eine Checkbox zwei Optionbuttons 4 Commandbuttons. Dazu einen Verweis auf scrrun.dll Damit wäre der Teil zum Zipen fertig. Das Unzipen ist noch nicht ganz fertig.
Gruß
Nepumuk

Baumstruktur in einer VB - Form darstellen

Forumthread: Baumstruktur in einer VB - Form darstellen

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Infobox / Tutorial

Interaktive Baumstruktur in einer VB-Form erstellen

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)

Baumstruktur in einer VB - Form darstellen

Forumthread: Baumstruktur in einer VB - Form darstellen

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Infobox / Tutorial

Interaktive Baumstruktur in einer VB-Form erstellen

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread