top of page

CREATE FOLDER USING VBA

​

​

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)
Else
FSO.DeleteFolder (F)
FSO.CreateFolder (F)

end if

end sub

​

​

  • Go to References and add Microsoft Scripting Runtime 

  • Paste Coding to you visual 

CREATE FILE USING VBA

​

​

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)
Else
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")
Else
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 ws As Worksheet
Dim Fso As Scripting.FileSystemObject
Dim Hfile As String
Set wb = ThisWorkbook
Set ws = wb.Sheets("MIS")
Set Fso = New Scripting.FileSystemObject
Hfile = "C:\Users\hp\Downloads\HTML FIle\Pivot.HTML"

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

newwb.Close

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)

Sheets("Name").Activate
Range("A1").Value = "Name"
Range("A2").Select

Do While df <> ""

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

df = Dir

Loop

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 = "https:/YourSharePointSite.sharepoint.com/Shared%20Documents/Excel%20File%20For%20Practice/"

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("A2:O2").Select
Range(Selection, Selection.End(xlDown)).Copy
wb.Activate
ws.Activate

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

wb2.Close

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

workbooks.open("https:/YourSharePointSite.sharepoint.com/Shared%20Documents/Excel%20File%20For%20Practice/Laptop.xlsx"

and file file name is Laptop India then code will be
workbooks.open("https:/YourSharePointSite.sharepoint.com/Shared%20Documents/Excel%20File%20For%20Practice/Laptop%20India.xlsx"

bottom of page