File system Objects

Working with text files

Sub One()

    Dim Returnvalue

    Returnvalue = Shell("notepad.exe", vbNormalFocus)

    AppActivate Returnvalue  

    SendKeys "this shoud appear in a new NotePad", True

    SendKeys "~", True

    SendKeys "This is line one", True

    SendKeys "~", True

    SendKeys "This is line two", True

    SendKeys "%favba%s", True  

End Sub

Sub createtextfile()

    Dim fs, f

    Set fs = CreateObject("scripting.filesystemobject")

    Set f = fs.createtextfile("C:\Documents and Settings\Ravi J\Desktop\excelvbatextfile.txt")

    f.writeline "This is the frist line"

    f.writeline "this is the second line"

    f.writeline "sucessfully created the text file"

End Sub

Transfer of text from notepad to excel (without opening notepad)

Sub Readtextfile()

    Dim fs, f

    Dim s As String, i As Integer

    Set fs = CreateObject("scripting.filesystemobject")

    Set f = fs.opentextfile("C:\Documents and Settings\Ravi J\Desktop\excelvbatextfile.txt", 1)

    While Not f.atendofline

        i = i + 1

        s = f.readline

        Range("a" & i) = s

    Wend

End Sub

Sub appendtextfile()

    Dim fs, f

    Dim s As String, i As Integer

    Set fs = CreateObject("scripting.filesystemobject")

    Set f = fs.opentextfile("C:\Documents and Settings\Ravi J\Desktop\excelvbatextfile.txt", 8)

    f.writeline "this line appended to the existing text as line no 4"

End Sub

Sub overwritetextfile()

    Dim fs, f

    Dim s As String, i As Integer

    Set fs = CreateObject("scripting.filesystemobject")

    Set f = fs.opentextfile("C:\Documents and Settings\Ravi J\Desktop\excelvbatextfile.txt", 2)

    f.writeline "this line will OVERWRITE the existing text"

End Sub

Reading data from a text file, split the text and write into xl in different cells

(text to col)

Sub abc()

'read data from a textfile,split& write in excel into diff column

Dim fs, f

Set fs = CreateObject("scripting.filesystemobject")

Set f = fs.opentextfile("c:\abc.txt")

'set col heading in excel

Range("a1") = "Emp ID"

Range("b1") = "Emp Name"

Range("c1") = "City"

Dim i As Integer

i = 1

Dim s As String

While Not f.atendofline

i = i + l

s = f.readline

Dim a

a = Split(s, ",")

Dim x As Integer

    For x = LBound(a) To UBound(a)

         Cells(i, x + 1) = a(x)

    Next

Wend

End Sub

File Dialog    The GetOpenFilename Method

Opening all xlsx file from a folder

Sub abc()

    Dim fpath As String

    fpath = "E:\BACKUP DATA 9TH DEC 2011\Ravi\Excel\New Folder\Templates"

    Dim fs, f, fl

    Set fs = CreateObject("scripting.filesystemobject")

    Set f = fs.getfolder(fpath)

    Set fl = f.Files

    For Each x In fl

        If Right(x.Name, 4) = "xlsx" Then

            Workbooks.Open (fpath & "\" & x.Name)

        End If

    Next

End Sub

Sub abc()

    Dim fpath As String

    With Application.FileDialog(msoFileDialogFolderPicker)

        .Show

        fpath = .SelectedItems(1)

    End With

    MsgBox fpath

End Sub

Adding filters to pickup files from the folder

Sub abc()

    Dim fpath As String

    With Application.FileDialog(msoFileDialogFilePicker)

        .AllowMultiSelect = True

        .Filters.Clear

        .Filters.Add "image files", "*.jpg,*.bmp", 1

        .Filters.Add "excel files", "*.xls,*.xlsx", 2

        .Filters.Add "All files", "*.*"

        .Show

            For Each f In .SelectedItems

                MsgBox f

            Next

    End With

End Sub