top of page


Sub Create_folder()

Dim fos As Scripting.FileSystemObject
Dim F As String

Set fso = New Scripting.FileSystemObject
F = ThisWorkbook.Path & "\" & Application.WorksheetFunction.Text(Now(), "DD MMM YY")
Fi = F & "\Day 1.xlsb"


If Not FSO.FolderExists(F) Then
FSO.CreateFolder (F)
FSO.DeleteFolder (F)
FSO.CreateFolder (F)

end if

end sub

  • Go to References and add  Microsoft Script Control 

  • Paste Coding to you visual 


Sub Create_File()

Dim fos As Scripting.FileSystemObject

Dim F As String

Dim Fi As String

Set fso = New Scripting.FileSystemObject
F = ThisWorkbook.Path & "\"

Fi = F & "\Day 1.xlsb"

If Not FSO.FileExists(F) Then
FSO.CreateFile (F)
FSO.DeleteFile (F)
FSO.CreateFile (F)

end if

end sub

Copy file one folder to other folder

Miscellaneous Code of File and Folder

Sub Copy_File()

Dim fos As Scripting.FileSystemObject
Dim DFolder As String
Dim Fi As String
Dim SFolder As String

Set fso = New Scripting.FileSystemObject
SFolder = ThisWorkbook.Path
DFolder = "C:\Users\hp\Desktop\App\"
Fi = "Loops.xlsb"

'Checking you file do exist as Source folder or not

If Not FSO.FileExists(SFolder & "\" & Fi) Then
A = MsgBox(Fi & " Not exists in folder " & SFolder, vbCritical, "Alert")
ElseIf FSO.FileExists(DFolder & "\" & Fi) Then
A = MsgBox(Fi & " Already in folder  " & DFolder, vbInformation, "Alert")
FSO.CopyFile (SFolder & "\" & Fi), DFolder, True
A = MsgBox(Fi & " Copy from " & SFolder & " to " & DFolder)
End If

End Sub

Excel File Formats 

  1.  xlAddIn   -----  .xla

  2. xlCSV   ------ .CSV

  3. xlExcel12 ----- .xlsb

  4. xlHtml ---- .htm

  5. xlOpenDocumentSpreadsheet --- .ods

  6. xlOpenXMLAddIn ---- .xlam

  7. xlOpenXMLWorkbook --- xlsx

  8. xlOpenXMLWorkbookMacroEnabled -- .xlsm

  9. xlTextMac --- .txt

  •  we are assuming  that you have dim FSO as object and set FSO = CreateObject("Scripting.filesystemobject")

  1. Create Folder = FSO.CreateFolder (Folder Path)

  2. Create File = FSO.CreateFile (File Path and Name with Extension)

  3. Delete Folder = FSO.DeleteFolder (Folder Path)

  4. Delete File = FSO.DeleteFolder (File path and Name with Extension)

  5. Check Existence of Folder =   FSO.FolderExists( Folder Path)

  6. Check Existence of File = FSO.FileExists ( File Path and Name with Extension)

  7. Copy File from one folder to other folder = FSO.CopyFIle ( Source folder path and file name with extension ), destination folder, True

  8. Open Excel File :-  Workbooks.Open(File Path with Name and Extension

  9. Close Special workbook =  We assumed you have dim Wb  as workbook   Wb.close ,  SaveChange:= true , to save and False to not save 

  10.  Close all Excel files = Workbooks.close

  11. Add New workbook  = workbooks.add

  12. Save Workbook =  Eg  wb.SaveAs Filename:= Workbook Path  with name ", FileFormat:= .xlCSV, Password:= "Afzal"  ( Check file formats in left side)  Example  ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\File.xlsx", FileFormat:=xlCSV, Password:="Afzal"

  13. Open Folder = Shell "Explorer.exe & Folder Path .vbNormalFocus Example ( Shell "Explorer.exe C:\Users\afzal_102599\Desktop\MY Drive\ICICI Bank\", vbNormalFocus)/

  14. ActiveSheet.Protection.AllowEditRanges.Add Title:="Range1", Range:=Columns( "A:A")

Create HTML File

Sub Create_HTML()
Dim wb As Workbook

Dim newwb As Workbook
Dim ws As Worksheet
Dim newws As Worksheet
Dim Fso As Scripting.FileSystemObject
Dim myfile As Scripting.TextStream
Dim Hfile As String

Dim pt As PivotTable

Set wb = ThisWorkbook
Set ws = wb.Sheets("MIS")
Set Fso = New Scripting.FileSystemObject
Set pt = ws.PivotTables("SalesTable")

Hfile = "C:\Users\hp\Downloads\HTML FIle\Pivot.HTML"

pt.PivotSelect "", xlOrigin, True

Set newwb = ActiveWorkbook
Set newws = ActiveSheet

Range("A3").PasteSpecial xlPasteAll

Fso.CreateTextFile (Hfile)
newwb.PublishObjects.Add(xlSourceRange, Hfile, "Sheet1", newws.UsedRange.Address, xlHtmlStatic).Publish (True)
Set myfile = Fso.OpenTextFile(Hfile)


End Sub

Get File Name from a Folder

Sub GetFileName()
Dim F As String
Dim df As String

F = "C:\Users\hp\***\***\"
df = Dir(F)

Range("A1").Value = "Name"

Do While df <> ""

Selection.Value = df
Selection.Offset(1, 0).Select

df = Dir


End Sub

SharePoint File and Folders

Sub Compile_SharePoint_File()
Dim wb As Workbook
Dim wb2 As Workbook
Dim ws As Worksheet
Dim sh As Worksheet
Dim rng As Range
Dim f As String

Set wb = ThisWorkbook
Set ws = wb.Sheets("Data")
Set sh = wb.Sheets("Home")
Set rng = sh.Range("A2", sh.Range("A2").End(xlDown))
f = "

With Application
.DisplayAlerts = False
.ScreenUpdating = False
.AskToUpdateLinks = False
.EnableEvents = False
End With

For Each rng In rng
Workbooks.Open (f & Application.WorksheetFunction.Substitute(rng, " ", "%20") & ".xlsx")
Set wb2 = ActiveWorkbook
Range(Selection, Selection.End(xlDown)).Copy

If Range("A2") = "" Then
Range("A2").PasteSpecial xlPasteValues
Range("A2").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
End If


Next rng


End Sub

SharePoint Site do not Accept space that is why we have to replace all space with %20.
Eg. you want to open a file from your SharePoint which name is Laptop, and location is  Documents/Excel file for Practice


below is code"https:/"

and file file name is Laptop India then code will be"https:/"

bottom of page