VB6 Code - Fungsi Untuk Menampilkan BrowseForFolder

Di bawah ini merupakan fungsi VB6 untuk menampilkan BrowseForFolder. Karena menggunakan metode Early Binding maka, Untuk keperluan ini Anda harus mereferensi objek "Microsoft Shell Controls And Automation" atau "Shell32.dll" yang biasa terletak pada SystemRoot\System32 (c:\Windows\System32\Shell32.dll).

Jika Anda ingin menggunakan metode Late Binding maka gantilah kode berikut:

Dim Sh as new Shell32.Shell
Dim Folder As Shell32.Folder

Menjadi:

Dim Sh as Object
Dim Folder
Set Sh = CreateObject("Shell.Application")

Function BrowseForFolder(Title As String, Optional RootFolder = "") As String
    On Error Resume Next
    Dim sh As New Shell32.Shell
    Dim Folder As Shell32.Folder
    Set Folder = sh.BrowseForFolder(Me.hwnd, "Open", 1, RootFolder)
    SelectFolder = Folder.Items.Item.Path
    set sh = nothing
    set Folder = nothing
End Function

'Berikut contoh penggunaan Fungsi Untuk Menampilkan BrowseForFolder
Private Sub Command1_Click()
   'jika ingin mengeksplore "c:\" saja
    MsgBox SelectFolder("Open Folder", "c:\")
   'Jika ingin mengeksplore directory keseluruhan
    MsgBox SelectFolder("Open Folder")
End Sub

READ MORE - VB6 Code - Fungsi Untuk Menampilkan BrowseForFolder

Contoh Menggunakan CommonDialog Open Save As

'Contoh untuk CommonDialog Open
Private Sub Command1_Click()

    On Error GoTo ErrHandler

    Dim strPath As String

    With CommonDialog1
        .CancelError = True
        .Flags = cdlOFNHideReadOnly
        .Filter = "All Files (*.*)|*.*|Text Files (*.txt)|*.txt|Batch Files (*.bat)|*.bat"
        .FilterIndex = 2
        .DialogTitle = "Open File"
        .ShowOpen
        strPath = .FileName
    End With
    'Code selanjutnya
    Exit Sub

ErrHandler:

    Exit Sub

End Sub

    'Contoh untuk CommonDialog Save As
Private Sub Command2_Click()

    On Error GoTo ErrHandler

    Dim strPath As String

    With CommonDialog1
        .CancelError = True
        .Flags = cdlOFNHideReadOnly
        .Filter = "All Files (*.*)|*.*|Text Files (*.txt)|*.txt|Batch Files (*.bat)|*.bat"
        .FilterIndex = 2
        .DialogTitle = "Save As"
        .ShowSave
        strPath = .FileName
    End With
    'Code selanjutnya
    Exit Sub

ErrHandler:

    Exit Sub
End Sub

    'Contoh untuk CommonDialog Save
Private Sub Command3_Click()

    On Error GoTo ErrHandler

    Dim strPath As String

    With CommonDialog1
        .CancelError = True
        .Flags = cdlOFNHideReadOnly
        .Filter = "All Files (*.*)|*.*|Text Files (*.txt)|*.txt|Batch Files (*.bat)|*.bat"
        .FilterIndex = 2
        .DialogTitle = "Save"
        .ShowSave
        strPath = .FileName
    End With
    'Code selanjutnya
    Exit Sub

ErrHandler:

    Exit Sub
End Sub

READ MORE - Contoh Menggunakan CommonDialog Open Save As

Contoh CommonDialog - Print Dengan Range Tertentu

Option Explicit

Private Sub Command1_Click()
    Dim myDatabase As Database
    Dim rsMyTable As Recordset
    Dim i As Integer
    Dim j As Integer
    Dim startpage As Integer

    CommonDialog1.Max = 3
    CommonDialog1.FromPage = 1
    CommonDialog1.ToPage = 3
    CommonDialog1.flags = 0
    CommonDialog1.ShowPrinter
    startpage = CommonDialog1.FromPage

    Printer.FontSize = 18

    Set myDatabase = OpenDatabase("nwind.mdb")
    Set rsMyTable = myDatabase.OpenRecordset("Customers")

    rsMyTable.MoveFirst

    If (CommonDialog1.flags And cdlPDPageNums) <> 0 Then
        MsgBox " Printing pages " & CommonDialog1.FromPage & " to " & CommonDialog1.ToPage
        Select Case startpage
            Case 1

            Case 2
                For i = 1 To 42
                    rsMyTable.MoveNext
                Next

            Case 3
                For i = 1 To 84
                    rsMyTable.MoveNext
                Next
        End Select

        If startpage <> 0 Then
            For j = startpage To CommonDialog1.ToPage
                For i = 1 To 42
                    If rsMyTable.EOF Then Exit For
                    Text1.Text = Text1.Text & rsMyTable!CompanyName & vbCrLf
                    Printer.Print rsMyTable!CompanyName
                    rsMyTable.MoveNext
                Next
                Printer.NewPage
            Next
            Printer.EndDoc
        End If

    ElseIf (CommonDialog1.flags And cdlPDSelection) <> 0 Then

        rsMyTable.MoveLast
        rsMyTable.MoveFirst
        For i = 1 To rsMyTable.RecordCount
            Text1.Text = Text1.Text & rsMyTable!CompanyName & vbCrLf
            rsMyTable.MoveNext
        Next
        MsgBox "Select text to be printed"
    Else
        For i = 1 To rsMyTable.RecordCount
            Text1.Text = Text1.Text & rsMyTable!CompanyName & vbCrLf
            rsMyTable.MoveNext
        Next
        Printer.Print Text1.Text
        Printer.EndDoc
        MsgBox "Printing all pages"
    End If
End Sub

Private Sub Command2_Click()
    Printer.Print Text1.SelText
    Printer.EndDoc
End Sub

Private Sub Form_Load()
    Command1.Caption = "Select Printing Option"
    Command2.Caption = "Print selected text"
End Sub

READ MORE - Contoh CommonDialog - Print Dengan Range Tertentu

Cara Menggunakan CommonDialog Printer

Private Sub Command1_Click()
    Dim BeginPage, EndPage, NumCopies, i
On Error GoTo ErrHandler
    With CommonDialog1
        .CancelError = True
        .ShowPrinter
        BeginPage = .FromPage
        EndPage = .ToPage
        NumCopies = .Copies
    End With
    
    For i = 1 To NumCopies
        'simpan kode di sini
    Next i
    Exit Sub
ErrHandler:
    Exit Sub
End Sub

READ MORE - Cara Menggunakan CommonDialog Printer

CommonDialog Help, Cara Menggunakannya

Private Sub Command1_Click()
    With CommonDialog1
        .HelpFile = "mis.chm"
        .HelpCommand = cdlHelpContents
        .ShowHelp
    End With
End Sub

READ MORE - CommonDialog Help, Cara Menggunakannya

CommonDialog Font, Cara Menggunakannya

Private Sub Command1_Click()
    With CommonDialog1
        .CancelError = True
        On Error GoTo ErrHandler
        .Flags = cdlCFEffects Or cdlCFBoth
        .ShowFont
        Text1.Font.Name = .FontName
        Text1.Font.Size = .FontSize
        Text1.Font.Bold = .FontBold
        Text1.Font.Italic = .FontItalic
        Text1.Font.Underline = .FontUnderline
        Text1.FontStrikethru = .FontStrikethru
        Text1.ForeColor = .Color
    End With
    Exit Sub
ErrHandler:
    Exit Sub
End Sub

READ MORE - CommonDialog Font, Cara Menggunakannya

CommonDialog Color, Cara Menggunakannya

Private Sub Command1_Click()
    With CommonDialog1
        .CancelError = True
        On Error GoTo ErrHandler
        .Flags = cdlCCRGBInit
        .ShowColor
        Form1.BackColor = .Color
    End With
    Exit Sub
ErrHandler:
End Sub

READ MORE - CommonDialog Color, Cara Menggunakannya

Menampilkan Dialog Regional Setting Menggunakan VB6

Private Sub Command1_Click()
    Call Shell("RunDLL32.exe  Shell32.dll Control_RunDLL InetCpl.cpl", vbNormalFocus)
End Sub

READ MORE - Menampilkan Dialog Regional Setting Menggunakan VB6

Bagaimana cara menjalankan Speech Properties Dialog - VB6

Karena Speech Properties dialog tidak terdapat dalam Windows\System32 maka untuk memanggilnya, Kita memerlukan kode di bawah:

Option Explicit 
 
Private Sub Command1_Click() 
    Shell "rundll32.exe shell32.dll,Control_RunDLL " & Chr(34) & "c:\program files\common files\microsoft shared\speech\sapi.cpl" & Chr(34) 
End Sub 

Perhatikan kode di atas, pathnya diapit oleh chr(34). Selain menggunakan chr(34) kita bisa juga menggunakan '"""' atau mengkonversi path menjadi format DOS 8.3 seperti yang telah ditulis terdahulu.

READ MORE - Bagaimana cara menjalankan Speech Properties Dialog - VB6

VB6 Code - Konfirmasi Sebelum Keluar Dari Aplikasi

Di bawah ini merupakan fungsi VB6 untuk melakukan konfirmasi sebelum keluar dari aplikasi. Mengapa dibuat menjadi fungsi? agar memiliki sifat mudah digunakan kembali, karena hampir tiap software yang dibuat, memerlukan fungsi di bawah ini:

Option Explicit

Public Function ConfirmExit(Optional Title As String = "Konfirmasi") As Boolean
    If MsgBox("Are you sure want to exit?", vbQuestion + vbYesNo, Title) = vbYes Then
        ConfirmExit = ConfirmExit
    Else
        ConfirmExit = True
    End If
End Function

Contoh penggunaan fungsi di atas:

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Cancel = ConfirmExit
End Sub

Penggunaan fungsi di atas dapat kita tempatkan pada event Unload ataupun QueryUnload.

READ MORE - VB6 Code - Konfirmasi Sebelum Keluar Dari Aplikasi

VB6 Code - Menampilkan Dialog Properties Sebuah File

Di bawah ini merupakan fungsi VB6 untuk menampilkan kotak dialog properties sebuah file.

Option Explicit

Type SHELLEXECUTEINFO
    cbSize As Long
    fMask As Long
    hwnd As Long
    lpVerb As String
    lpFile As String
    lpParameters As String
    lpDirectory As String
    nShow As Long
    hInstApp As Long
    lpIDList As Long
    lpClass As String
    hkeyClass As Long
    dwHotKey As Long
    hIcon As Long
    hProcess As Long
End Type

Public Const SEE_MASK_INVOKEIDLIST = &HC
Public Const SEE_MASK_NOCLOSEPROCESS = &H40
Public Const SEE_MASK_FLAG_NO_UI = &H400

Declare Function ShellExecuteEX Lib "shell32.dll" Alias "ShellExecuteEx" (SEI As SHELLEXECUTEINFO) As Long

Public Sub ShowProps(FileName As String, OwnerhWnd As Long)

  Dim SEI As SHELLEXECUTEINFO
    Dim lngReturn As Long

  With SEI
        .cbSize = Len(SEI)
        .fMask = SEE_MASK_NOCLOSEPROCESS  Or _
            SEE_MASK_INVOKEIDLIST Or SEE_MASK_FLAG_NO_UI
        .hwnd = OwnerhWnd
        .lpVerb = "properties"
        .lpFile = FileName
        .lpParameters = vbNullChar
        .lpDirectory = vbNullChar
        .nShow = 0
        .hInstApp = 0
        .lpIDList = 0
    End With

  lngReturn = ShellExecuteEX(SEI)

End Sub

Contoh menggunakan dialog properties sebuah file

Option Explicit

Private Sub Command1_Click()
    Call ShowProps("C:\boot.ini", Me.hwnd)
End Sub

READ MORE - VB6 Code - Menampilkan Dialog Properties Sebuah File

VB6 Code - Fungsi API Untuk Browse For Folder

Mengenai fungsi-fungsi API untuk menampilkan dialog browse for folder dengan menggunakan kode-kode VB6:

Option Explicit

Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260

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
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long

Public 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

Public Function BrowseForFolder(hwnd As Long, Optional Title As String = "Browse For Folder") As String
    Dim lpIDList As Long
    Dim sBuffer As String
    Dim szTitle As String
    Dim tBrowseInfo As BrowseInfo
    szTitle = "This Is My Title"
    With tBrowseInfo
        .hWndOwner = Me.hwnd
        .lpszTitle = lstrcat(szTitle, "")
        .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
    End With
    lpIDList = SHBrowseForFolder(tBrowseInfo)
    If (lpIDList) Then
        sBuffer = Space(MAX_PATH)
        SHGetPathFromIDList lpIDList, sBuffer
        sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
        BrowseForFolder = sBuffer
    End If
End Function

Adapun contoh untuk fungsi API diatas:

Private Sub Command1_Click()
    Text1.Text = BrowseForFolder(Me.hwnd)
End Sub

READ MORE - VB6 Code - Fungsi API Untuk Browse For Folder

VB6 Code - Menampilkan Kotak Dialog Shutdown

Di bawah ini merupakan fungsi API untuk menampilkan kotak dialog shutdown menggunakan kode VB6. Fungsi yang digunakan adalah SHShutDownDialog yang terdapat pada Shell32.dll.

Option Explicit

Private Declare Function SHShutDownDialog Lib "shell32" Alias "#60" (ByVal sParam As Long) As Long

Contoh penggunaan fungsi API di atas:

Private Sub Command1_Click()
    SHShutDownDialog 0
End Sub

READ MORE - VB6 Code - Menampilkan Kotak Dialog Shutdown

Data Link Properties Dialog Box Cara Menampilkannya

'simpan kode di bawah pada modul Option Explicit 
 
Public Function getADOConnectionString(Optional ByVal cnStringToEdit As String = "", Optional sPrePromptUserMessage As String = "") As String 
 
  Dim sActivity As String 
  Dim dl As Object 
  Dim cn As Object 
 
    On Error GoTo ErrGetAdoConnectionString 
    sActivity = "Creating Datalinks object." 
 
    Set dl = CreateObject("DataLinks") 
 
    If Not "" = cnStringToEdit) Then 
 
        If Not "" = sPrePromptUserMessage) Then 
            MsgBox sPrePromptUserMessage, vbInformation, "Connecting to Database..." 
        End If 
        sActivity = "Creating ADODB.Connection object" 
        Set cn = CreateObject("ADODB.Connection") 
 
        cn.ConnectionString = "Provider=SQLOLEDB.1;Initial Catalog=PUBS" 
 
        sActivity = "Prompting user to  edit  connect string" 
        dl.PromptEdit cn 
 
      Else 
        sActivity = "Prompting user for  new  connect string" 
        Set cn = dl.PromptNew() 
 
    End If 
 
    If cn Is Nothing Then 
        getADOConnectionString = "" 
        Exit Function 
    End If 
 
    getADOConnectionString = cn.ConnectionString 
 
    Set cn = Nothing 
 
Exit Function 
 
ErrGetAdoConnectionString: 
 
  Dim sMsg As String 
 
    Set cn = Nothing 
 
    sMsg = "Error While [" + sActivity + "].  Details are below: " + vbCrLf 
    sMsg = sMsg + "Description:[" + Err.Description + "]." + vbCrLf 
    sMsg = sMsg + "Source:[" & Err.Source & "]." + vbCrLf 
    sMsg = sMsg + "Number:[" & Err.Number & "]." + vbCrLf 
    sMsg = sMsg + "Help File:[" & Err.HelpFile & "]." + vbCrLf 
    MsgBox sMsg, vbCritical, "Error Connecting to Database." 
 
End Function 

Contoh penggunaan fungsi di atas:

'simpan kode di bawah pada form Option Explicit 
 
Private Sub Command1_Click() 
 
On Error GoTo ErrHandler 
 
    Dim strCon As String 
    strCon = getADOConnectionString() 
    If strCon = "" Then Exit Sub 
    'kode selanjutnya disini      
    Exit Sub 
     
ErrHandler: 
 
    MsgBox Err.Number & vbNewLine & Err.Description, vbExclamation + vbOKOnly, "Connection Error" 
 
End Sub 

READ MORE - Data Link Properties Dialog Box Cara Menampilkannya

VB6 Code - Menampilkan Dialog Open With

Di bawah ini merupakan kode VB6 untuk menampilkan Dialog Open With. Bagaimanakah caranya:

Option Explicit

Private Sub ShowOpenWith(Filename As String)
     Dim x As Long
     x = Shell("rundll32.exe shell32.dll,OpenAs_RunDLL " & Filename)
End Sub

Contoh penggunaan menampilkan dialog open with:

Private Sub Command1_Click()
     ShowOpenWith "C:\boot.ini"
End Sub

READ MORE - VB6 Code - Menampilkan Dialog Open With