Sometimes we need to interact with files and directories that exist on the hard drive, for example if we want to export existing data into MS. Excel files, or maybe you want can to restore its database from backup results that have been made before
Here are some examples of code that can handle file and directory issues
Here are some examples of code that can handle file and directory issues
T&T#1) CHECK FILE PROPERTIES
Open the new Standard.Exe project, place 1 CommandButton and change its caption to Properties, double click commandbutton and insert the following code:
Private Sub Command1_Click()
'Ganti 'c:\autoexec.bat' dengan nama file yang Anda
'ingin lihat kotak dialog property-nya...
Call ShowProps("c:\autoexec.bat", Me.hwnd)
End Sub
Public Sub ShowProps(FileName As String, OwnerhWnd _
As Long)
Dim SEI As SHELLEXECUTEINFO
Dim r 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
r = ShellExecuteEX(SEI)
End Sub
Click Project -> Add Module, double click module1 and enter the following code :
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
Press F5 and run the project
Click the Properties button, it will display the properties of the autoexec.bat file that we use as an example
T&T#2) CREATE EXCEL FILE
Open the new Standard.Exe project, insert 1 CommandButton into the form, double click commandbutton and enter the following code:
Private Sub Command1_Click() Dim xlApp As Excel.Application Dim xlWB As Excel.Workbook Dim xlWS As Excel.Worksheet Set xlApp = New Excel.Application Set xlWB = xlApp.Workbooks.Add Set xlWS = xlWB.Worksheets.Add 'this line will fill cell (2,2) with 'text "hello" and fill cell (1,3) with 'text "World" xlWS.Cells(2, 2).Value = "hello" xlWS.Cells(1, 3).Value = "World" 'This line will save the spreadsheet into 'file "c:\mysheet.xls". xlWS.SaveAs "c:\mysheet.xls" xlApp.Quit 'free some memory... Set xlWS = Nothing Set xlWB = Nothing Set xlApp = Nothing End Sub
Press F5 and run the project
T&T#3) OPEN THE DIALOGUE BOX “BROWSE FOR FOLDER”
Open the new Standard.Exe project, insert 1 CommandButton into the form, and change the caption to Browse, double click commandbutton, and enter the following code:
Private Sub Command1_Click() Dim lpIDList As Long Dim sBuffer As String Dim szTitle As String Dim tBrowseInfo As BrowseInfo 'Change the "Browse For Folders" dialogue title 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 var is the selected directory choose by user. sBuffer = Left(sBuffer, InStr(sBuffer, _ vbNullChar) - 1) MsgBox sBuffer End If End Sub
Last but not least click Project -> Add Module, double click Module1, and enter the following code:
Public Const BIF_RETURNONLYFSDIRS = 1 Public Const BIF_DONTGOBELOWDOMAIN = 2 Public Const MAX_PATH = 260 Declare Function SHBrowseForFolder Lib _ "shell32" (lpbi As BrowseInfo) As Long Declare Function SHGetPathFromIDList Lib "shell32" _ (ByVal pidList As Long, ByVal lpBuffer As String) As Long 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
Press F5 and run the project
T&T#4) OPEN WINDOWS EXPLORER WITH SPECIFIC DIREKTORY
Open the new Standard.Exe project, insert 1 CommandButton into the form, double click commandbutton, and enter the following code:
Private Sub Command1_Click()
'specify the directory name that you will be open with Windows Explorer
OpenExplorer ("C:\Program Files\")
End Sub
Public Sub OpenExplorer(Optional InitialDirectory As String)
ShellExecute 0, "Explore", InitialDirectory, vbNullString, _
vbNullString, SW_SHOWNORMAL
End Sub
Click Project -> Add Module, double klik Module1, and enter the following code :
Declare 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 Public Const SW_SHOWNORMAL = 1
Press F5 and run the project
T&T#5) CHECK IF DIRECTORY EXIST
T&T#5) CHECK IF DIRECTORY EXIST
Open the new Standard.Exe project, double click Form1 and enter the following code:
'The example of the checked directory is "C: \ Windows"
Press F5 and run the project
'The example of the checked directory is "C: \ Windows"
Private Sub Form_Load()
Const ATTR_DIRECTORY = 16
If Dir$("c:\windows", ATTR_DIRECTORY) <> "" Then
MsgBox "Direktori ada!", vbInformation, "Ada"
Else MsgBox "Directory does not exist!", vbCritical, "Not Found"
End If
End Sub
Press F5 and run the project
T&T#6) CHECK IF FILE EXIST
Open the new Standard.Exe project, double click Form1 and enter the following code:
'Example file"C:\autoexec.bat"
Private Sub Form_Load()
'Change "c:\autoexec.bat" with the complete file name (include the path)
If Dir$("c:\autoexec.bat") <> "" Then
MsgBox "File Exist!", vbInformation, "Exist"
Else
MsgBox "File Not Found!", vbCritical, "Not Found"
End If
End Sub
Press F5 and run the project
T&T#7) MOVING FILE
Open the new Standard.Exe project, insert 1 CommandButton into the form, double click commandbutton, and enter the following code:
'this will move file 'c:\MyFile.Zip' to 'direktori 'c:\MyDir'.
Private Sub Command1_Click()
A = MoveFile("c:\MyFile.Zip", "c:\MyDir\MyFile.Zip")
If A Then
MsgBox "File successfully move!", _
vbInformation, "Sukses Pindah File"
Else
MsgBox "Error. Can not move file!" & Chr(13) & _
"Maybe file does not exist" & _
Chr(13) & "or file already exist in " & _
Chr(13) & _
"destination folder!", vbCritical, "Error: Moving File"
End If
End Sub
Click Project -> Add Module, double click Module1, and enter the following code :
Declare Function MoveFile Lib "kernel32" Alias "MoveFileA" _ (ByVal lpExistingFileName As String, ByVal lpNewFileName As String) _ As Long
Press F5 and run the project
T&T#8) GET FILE NAME
Open the new Standard.Exe project, double click Form1 and enter the following code:
Private Sub Form_Load()
MsgBox StripPath("c:\myfolder\myfile.exe")
End Sub
Function StripPath(T$) As String
Dim x%, ct%
StripPath$ = T$
x% = InStr(T$, "\")
Do While x%
ct% = x%
x% = InStr(ct% + 1, T$, "\")
Loop
If ct% > 0 Then StripPath$ = Mid$(T$, ct% + 1)
End Function
Press F5 and run the project
T&T#9) GET FILE EXTENSION
Open the new Standard.Exe project, double click Form1 and enter the following code:
Private Sub Form_Load()
MsgBox GetExtension("c:\myfolder\myfile.exe")
End Sub
Function GetExtension(FileName As String)
Dim PthPos, ExtPos As Integer
For i = Len(FileName) To 1 Step -1
If Mid(FileName, i, 1) = "." Then
ExtPos = i
For j = Len(FileName) To 1 Step -1
If Mid(FileName, j, 1) = "\" Then
PthPos = j
Exit For
End If
Next j
Exit For
End If
Next i
If PthPos > ExtPos Then
Exit Function
Else
If ExtPos = 0 Then Exit Function
GetExtension = Mid(FileName, ExtPos + 1, _
Len(FileName) - ExtPos)
End If
End Function
Press F5 and run the projectT&T#10) GET DIRECTORY SIZE
Open the new Standard.Exe project, insert 1 CommandButton into the form, double click commandbutton, and enter the following code:
Private Sub Command1_Click()
MsgBox "Directory Size C:\Windows = " & _
Format(SizeOf("C:\Windows"), "#,#") & _
" bytes", vbInformation, "Directory Size"
End Sub
Public Function SizeOf(ByVal DirPath As String) As Double
Dim hFind As Long
Dim fdata As WIN32_FIND_DATA
Dim dblSize As Double
Dim sName As String
Dim x As Long
On Error Resume Next
x = GetAttr(DirPath)
If Err Then SizeOf = 0: Exit Function
If (x And vbDirectory) = vbDirectory Then
dblSize = 0
Err.Clear
sName = Dir$(EndSlash(DirPath) & "*.*", vbSystem _
Or vbHidden Or vbDirectory)
If Err.Number = 0 Then
hFind = FindFirstFile(EndSlash(DirPath) & _
"*.*", fdata)
If hFind = 0 Then Exit Function
Do
If (fdata.dwFileAttributes And vbDirectory) = _
vbDirectory Then
sName = Left$(fdata.cFileName, _
InStr(fdata.cFileName, vbNullChar) - 1)
If sName <> "." And sName <> ".." Then
dblSize = dblSize + _
SizeOf(EndSlash(DirPath) & sName)
End If
Else
dblSize = dblSize + fdata.nFileSizeHigh * _
65536 + fdata.nFileSizeLow
End If
DoEvents
Loop While FindNextFile(hFind, fdata) <> 0
hFind = FindClose(hFind)
End If
Else
On Error Resume Next
dblSize = FileLen(DirPath)
End If
SizeOf = dblSize
End Function
Private Function EndSlash(ByVal PathIn As String) As String
If Right$(PathIn, 1) = "\" Then
EndSlash = PathIn
Else
EndSlash = PathIn & "\"
End If
End Function
Click Project -> Add Module, double klik Module1 and enter the following code :
Public Const MAX_PATH = 260 Public Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type Public 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 Declare Function FindFirstFile Lib "kernel32" _ Alias "FindFirstFileA" (ByVal lpFileName As String, _ lpFindFileData As WIN32_FIND_DATA) As Long Declare Function FindNextFile Lib "kernel32" _ Alias "FindNextFileA" (ByVal hFindFile As Long, _ lpFindFileData As WIN32_FIND_DATA) As Long Declare Function FindClose Lib "kernel32" _ (ByVal hFindFile As Long) As Long
Press F5 and run the project
T&T#11) DELETE FILE TO RECYCLE BIN
Open the new Standard.Exe project, insert 1 CommandButton into the form, double click commandbutton, and enter the following code:
Private Sub Command1_Click()
Dim MyBool As Boolean
DelToRecycBin ("c:\My Documents\MyFile.Zip")
End Sub
Public Function DelToRecycBin(FileName As String)
Dim FileOperation As SHFILEOPSTRUCT
Dim lReturn As Long
On Error GoTo DelToRecycBin_Err
With FileOperation
.wFunc = F0_DELETE
.pFrom = FileName
.fFlags = F0F_ALLOWUNDO + F0F_CREATEPROGRESSDLG
End With
lReturn = SHFileOperation(FileOperation)
Exit Function
DelToRecycBin_Err:
MsgBox Err.Number & Err.Description
End Function
Click Project -> Add Module, double klik Module1, and enter the following code :
'Depend on your windows setting if you disable delete to recycle bin 'file akan will be deleted permanently Public Type SHFILEOPSTRUCT hwnd As Long wFunc As Long pFrom As String pTo As String fFlags As Integer fAnyOperationsAborted As Boolean hNameMappings As Long lpszProgressTitle As String End Type Declare Function SHFileOperation Lib "shell32.dll" _ Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long Public Const F0_DELETE = &H3 Public Const F0F_ALLOWUNDO = &H40 Public Const F0F_CREATEPROGRESSDLG As Long = &H0
Press F5 and run the project
1 comments:
commentsMUANTAP MAS BROW...
Reply