VBA/Excel/Access/Word/Excel/Workbook File

Get active workbook name only(without path name)

   <source lang="vb">

Sub GetFileName()

 Dim BackSlash As Integer, Point As Integer
 Dim FilePath As String, FileName As String
 Dim i As Integer
 
 FilePath = ActiveWorkbook.FullName
 For i = Len(FilePath) To 1 Step -1
   If Mid$(FilePath, i, 1) = "." Then
     Point = i
     Exit For
   End If
 Next i
 If Point = 0 Then Point = Len(FilePath) + 1
 For i = Point - 1 To 1 Step -1
   If Mid$(FilePath, i, 1) = "\" Then
     BackSlash = i
     Exit For
   End If
 Next i
 Debug.Print Mid$(FilePath, BackSlash + 1, Point - BackSlash - 1)
 

End Sub

</source>
   
  

Get next file name

   <source lang="vb">

Public Sub CreateNextFileName()

 Dim Workbook1 As Workbook
 Dim I As Integer
 Dim FileName As String
 
 Set Workbook1 = Workbooks.Add(Template:=ThisWorkbook.Path & "\Temp.xls")
 I = 0
 Do
   I = I + 1
   FileName = ThisWorkbook.Path & "\Temp" & I & ".xls"
 Loop While FileExists(FileName)
  
 Workbook1.SaveAs FileName:=FileName

End Sub

</source>
   
  

Get path of current work book

   <source lang="vb">

Sub workBook()

   Debug.Print ThisWorkbook.Path

End Sub

</source>
   
  

Get work book from same directory

   <source lang="vb">

Sub ActivateWorkbook2()

  Dim stPath As String
  Dim myFileName As String
  Dim stFullName As String
  Dim myWorkbook As workBook
  myFileName = "SalesData1.xls"
  stPath = ThisWorkbook.Path
  stFullName = stPath & "\" & myFileName
  Set myWorkbook = Workbooks.Open(Filename:=stFullName)

End Sub

</source>
   
  

Is selected file open?

   <source lang="vb">

Sub IsWorkbookOpen()

  Dim myWorkbook As Workbook
  Dim stName As String

  stName = "c:\abc.xls"
  On Error Resume Next
  Set myWorkbook = Workbooks(stName)
  If Not myWorkbook Is Nothing Then
     MsgBox True
  End If
 
  MsgBox False

End Sub

</source>
   
  

Load excel file

   <source lang="vb">

Sub LoadExcelFile()

 Dim result As Variant
 result = Application.GetOpenFilename("Excel files,*.xl?", 1)
 If result = False Then Exit Sub
 Workbooks.Open result

End Sub

</source>
   
  

Open a text file for workbook

   <source lang="vb">

Public Sub OpenTextTest()

 Dim FileName As String
 FileName = ThisWorkbook.Path & "\Data.txt"
 Call Workbooks.OpenText(FileName:=FileName, DataType:=xlDelimited, Tab:=True, DecimalSeparator:=",", ThousandsSeparator:=".")

End Sub

</source>
   
  

Open Workbook file (xls file)

   <source lang="vb">

Sub ActivateWorkbook1()

  Dim stFullName As String
  Dim myWorkbook As Workbook
  stFullName = "c:\SalesData1.xls"
  Set myWorkbook = Workbooks.Open(Filename:=stFullName)

End Sub

</source>
   
  

Presents user with a GetOpenFileName dialog that allows multiple file selection.

   <source lang="vb">

Sub main()

  GetExcelFiles ("YourTitle")

End Sub Function GetExcelFiles(sTitle As String) As Variant

   Dim sFilter As String
   Dim bMultiSelect As Boolean
   sFilter = "Workbooks (*.xls), *.xls"
   bMultiSelect = True
   GetExcelFiles = Application.GetOpenFilename(FileFilter:=sFilter, _
       Title:=sTitle, MultiSelect:=bMultiSelect)

End Function

</source>
   
  

Save as the active workbook

   <source lang="vb">

Sub saveAsDemo()

  ActiveWorkbook.SaveAs FileName:="c:\MyFile.xls"

End Sub

</source>
   
  

Save changes automatically, specify this as a parameter of the Close method

   <source lang="vb">

    Sub CloseWorkbook()
          Dim myWorkbook1 As Workbook
          Set myWorkbook1 = Workbooks.Open(FileName:="C:\Data\SalesData1.xlsx")
          Range("A1").Value = Format(Date, "ddd mmm dd, yyyy")
          Range("A1").EntireColumn.AutoFit
          myWorkbook1.Close SaveChanges:=True
    End Sub
</source>
   
  

tells you how many workbooks are open

   <source lang="vb">

Sub CountBooks()

     MsgBox Workbooks.Count

End Sub

</source>