Open Specific folder to select a file

[SriDurga]

Hi experts,
I need to open a specific folder path: "C:\Desktop\Current\Week" and prompt msg asking to "select a file to open".
After opening a file, few actions needs to be performed in that selected file for eg:"text to columns; delimiter and deleting column A " and file should be saved automatically.
Kindly help me with a VBA code.

Thanks in advance.

 

[Anbuselvam]

Try this code

Sub OpenAndProcessFile()
    ' Prompt user to select a file to open
    Dim filePath As Variant
    filePath = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx", , "Select a file to open", "C:\Desktop\Current\Week.xlsx")
    If filePath = False Then Exit Sub ' User clicked Cancel

    ' Open selected file
    Workbooks.Open filePath

    ' Perform text to columns and delete column A
    With ActiveSheet
        .Columns("A:A").Delete Shift:=xlToLeft ' Delete column A
        .Range("A1").CurrentRegion.TextToColumns _
            Destination:=.Range("A1"), _
            DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=False, _
            Tab:=False, _
            Semicolon:=False, _
            Comma:=True, _
            Space:=False, _
            Other:=False, _
            FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)) ' Text to columns with comma delimiter
    End With

    ' Save changes to file
    ActiveWorkbook.Save

End Sub

 

[SriDurga]

Try this code

Sub OpenAndProcessFile()
    ' Prompt user to select a file to open
    Dim filePath As Variant
    filePath = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx", , "Select a file to open", "C:\Desktop\Current\Week.xlsx")
    If filePath = False Then Exit Sub ' User clicked Cancel

    ' Open selected file
    Workbooks.Open filePath

    ' Perform text to columns and delete column A
    With ActiveSheet
        .Columns("A:A").Delete Shift:=xlToLeft ' Delete column A
        .Range("A1").CurrentRegion.TextToColumns _
            Destination:=.Range("A1"), _
            DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=False, _
            Tab:=False, _
            Semicolon:=False, _
            Comma:=True, _
            Space:=False, _
            Other:=False, _
            FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)) ' Text to columns with comma delimiter
    End With

    ' Save changes to file
    ActiveWorkbook.Save

End Sub

Wow, that helps, but am not able to select the file in this path "C:\Desktop\Current\Week" instead it is opening documents folders and asking me to select a file.
I again need to browse this path (C:\Desktop\Current\Week) to select the file in "Week" folder, any suggestions pls

 

[Anbuselvam]

filePath = "C:\Desktop\Current\Week"

 

[SriDurga]

filePath = "C:\Desktop\Current\Week"

Hi Still opening documents folder in PC

 

[Anbuselvam]

send me the full code of what you are changed and used.

 

[SriDurga]

send me the full code of what you are changed and used.

Sub Format_Files()


' Prompt user to select a file to open
Dim filePath As Variant
filePath = Application.GetOpenFilename("Excel Files (*.csv), *.csv", , "Select a file to open", "C:\Users\tamman\Desktop\PP\Dump\Daily PP.csv")
If filePath = False Then Exit Sub ' clicked Cancel

' Open selected file
Workbooks.Open filePath

' Perform text to columns and delete column
With ActiveSheet
ActiveCell.Offset(0, 2).Columns("A:A").EntireColumn.Select
Selection.Insert Shift:=xlToRight
ActiveCell.Offset(0, -1).Columns("A:A").EntireColumn.Select
Selection.TextToColumns Destination:=ActiveCell, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="@", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
Selection.Delete Shift:=xlToLeft
ActiveCell.Offset(0, -2).Range("A1").Select

End With

' Save changes to file
ActiveWorkbook.Save

End Sub

 

[Anbuselvam]

Remove

filePath = Application.GetOpenFilename("Excel Files (*.csv), *.csv", , "Select a file to open", "C:\Users\tamman\Desktop\PP\Dump\Daily PP.csv")

Add

filePath = "C:\Users\tamman\Desktop\PP\Dump\Daily PP.csv"

 

[HaHoBe]

Hi SriDurga,

AFAIR the path to Desktop should be part of each individual user. So maybe try the alteration for the first part of the code:

Sub OpenAndProcessFile()
  Dim strPathFile As String
  Dim strInitial As String
  Dim oWSHShell As Object
 
  Set oWSHShell = CreateObject("WScript.Shell")
  strInitial = oWSHShell.SpecialFolders("Desktop") & "\Current\Week\"
  Set oWSHShell = Nothing
 
  With Application.FileDialog(msoFileDialogFilePicker)
    .Filters.Clear
    .Filters.Add "Excel Files", "*.xl*"
    .InitialFileName = strInitial
    .AllowMultiSelect = True
  If .Show = -1 Then
    strPathFile = .SelectedItems(1)
  Else
    Exit Sub
  End If
  End With
 
  ' Open selected file
  Workbooks.Open strPathFile

And in the future please use code-tags to display your procedures as described in How to Post Your VBA Code

Ciao,
Holger

 

[SriDurga]

Hi SriDurga,

AFAIR the path to Desktop should be part of each individual user. So maybe try the alteration for the first part of the code:

Sub OpenAndProcessFile()
  Dim strPathFile As String
  Dim strInitial As String
  Dim oWSHShell As Object
 
  Set oWSHShell = CreateObject("WScript.Shell")
  strInitial = oWSHShell.SpecialFolders("Desktop") & "\Current\Week\"
  Set oWSHShell = Nothing
 
  With Application.FileDialog(msoFileDialogFilePicker)
    .Filters.Clear
    .Filters.Add "Excel Files", "*.xl*"
    .InitialFileName = strInitial
    .AllowMultiSelect = True
  If .Show = -1 Then
    strPathFile = .SelectedItems(1)
  Else
    Exit Sub
  End If
  End With
 
  ' Open selected file
  Workbooks.Open strPathFile

And in the future please use code-tags to display your procedures as described in How to Post Your VBA Code

Ciao,
Holger

Thank you so much, it works