Happy Codings - Programming Code Examples
Html Css Web Design Sample Codes CPlusPlus Programming Sample Codes JavaScript Programming Sample Codes C Programming Sample Codes CSharp Programming Sample Codes Java Programming Sample Codes Php Programming Sample Codes Visual Basic Programming Sample Codes


Visual Basic Programming Code Examples

Visual Basic > Files Directories Drives Code Examples

Copy, move, delete and browse for folder

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223
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