Visual Basic Programming Code Examples

Copy, move, delete and browse for folder 'save file and rename them to [name].BAS Attribute VB_Name = "Win95_Functions" Option Explicit Public type SHFILEOPSTRUCT hWnd As Long wFunc As Long pFrom As String pTo As String fFlags As Integer fAborted As Boolean hNameMaps As Long sProgress As String End Type 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 Global FileDestination As String Public Const BIF_RETURNONLYFSDIRS = 1 Public Const MAX_PATH = 260 Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long) Public Declare Function lstrcat Lib "kernel32" alias "lstrcatA" _ (ByVal lpString1 As String, ByVal lpString2 As String) As Long Public Declare Function SHBrowseForFolder Lib "shell32" _ (lpbi As BrowseInfo) As Long Public Declare Function SHGetPathFromIDList Lib "shell32" _ (ByVal pidList As Long, ByVal lpBuffer As String) As Long Public Const FO_COPY = &H2 Public Const FO_DELETE = &H3 Public Const FO_MOVE = &H1 Public Const FO_RENAME = &H4 Public Const FOF_ALLOWUNDO = &H40 Public Const FOF_CONFIRMMOUSE = &H2 Public Const FOF_FILESONLY = &H80 ' on *.*, do only files Public Const FOF_MULTIDESTFILES = &H1 Public Const FOF_NOCONFIRMATION = &H10 ' Don't prompt the user. Public Const FOF_NOCONFIRMMKDIR = &H200 ' don't confirm making any needed dirs Public Const FOF_RENAMEONCOLLISION = &H8 Public Const FOF_SILENT = &H4 ' don't create progress/report Public Const FOF_SIMPLEPROGRESS = &H100 ' means don't show names of files Public Const FOF_WANTMAPPINGHANDLE = &H20 ' Fill in SHFILEOPSTRUCT.hNameMappings Public Declare Function SHFileOperation Lib "shell32.dll" alias _ "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long Public Function ShellRename(ParamArray vntFileName() As Variant) As Long dim i As Integer dim sFileNames As String dim Dick As String dim SHFileOp As SHFILEOPSTRUCT For i = LBound(vntFileName) To UBound(vntFileName) sFileNames = sFileNames & vntFileName(i) & vbNullChar Next sFileNames = sFileNames & vbNullChar Dick = FileDestination With SHFileOp .wFunc = &H4 .pFrom = sFileNames .fFlags = FOF_ALLOWUNDO .pTo = Dick end With ShellRename = SHFileOperation(SHFileOp) End Function Public Function ShellCopy(ParamArray vntFileName() As Variant) As Long dim i As Integer dim sFileNames As Variant dim Dick As String dim SHFileOp As SHFILEOPSTRUCT For i = LBound(vntFileName) To UBound(vntFileName) sFileNames = sFileNames & vntFileName(i) & vbNullChar Next sFileNames = sFileNames & vbNullChar Dick = FileDestination With SHFileOp .wFunc = &H2 .pFrom = sFileNames .fFlags = FOF_ALLOWUNDO .pTo = Dick end With ShellCopy = SHFileOperation(SHFileOp) End Function Public Function ShellMove(ParamArray vntFileName() As Variant) As Long dim i As Integer dim sFileNames As Variant dim Dick As String dim SHFileOp As SHFILEOPSTRUCT For i = LBound(vntFileName) To UBound(vntFileName) sFileNames = sFileNames & vntFileName(i) & vbNullChar Next sFileNames = sFileNames & vbNullChar Dick = FileDestination With SHFileOp .wFunc = &H1 .pFrom = sFileNames .fFlags = FOF_ALLOWUNDO .pTo = Dick end With ShellMove = SHFileOperation(SHFileOp) End Function Public Function ShellDelete(ParamArray vntFileName() As Variant) As Long dim i As Integer dim sFileNames As String dim SHFileOp As SHFILEOPSTRUCT For i = LBound(vntFileName) To UBound(vntFileName) sFileNames = sFileNames & vntFileName(i) & vbNullChar Next sFileNames = sFileNames & vbNullChar With SHFileOp .wFunc = FO_DELETE .pFrom = sFileNames .fFlags = FOF_ALLOWUNDO end With ShellDelete = SHFileOperation(SHFileOp) End Function Public 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 end If BrowseForFolder = sPath End Function Return