help me change code read select folder!!!

Nguyen Anh Dung

Board Regular
Joined
Feb 28, 2020
Messages
102
Office Version
  1. 2016
Platform
  1. Windows
i have code vba, help me change code when run only need select folder have file csv and run not input list file as below

FolderPath = "D:\test_file\"

FileList = Array("20200310_07_002_QTB_GS023662-gps.csv", "20200310_07_003_QTB_GS033662-gps.csv", "20200310_07_004_QTB_GS043662-gps.csv")


Code:
Sub ProcessMultipleFiles()

Dim NewFileName As String

Dim FileList As Variant, FilePath As Variant

Dim FolderPath As String

Dim FSO As Object

Set FSO = CreateObject("Scripting.FileSystemObject")

FolderPath = "D:\test_file\"

FileList = Array("20200310_07_002_QTB_GS023662-gps.csv", "20200310_07_003_QTB_GS033662-gps.csv", "20200310_07_004_QTB_GS043662-gps.csv")

For Each FilePath In FileList

FilePath = FolderPath & FilePath

If FSO.FileExists(FilePath) Then

NewFileName = FSO.GetBaseName(FilePath)

NewFileName = Left(NewFileName, Len(NewFileName) - 4) & "_N.csv"

FSO.CopyFile FilePath, FolderPath & NewFileName, True

CSVAmend2 FolderPath, NewFileName

Else

MsgBox FilePath & " not found"

End If

Next FilePath

End Sub

Sub CSVAmend2(FolderPath As String, FileName As String)

Dim wb As Workbook, ws As Worksheet, rng As Range, headers As Variant

headers = Array("ID", "trksegID", "lat", "lon", "ele", "time", "time_N")

Set wb = Workbooks.Open(FolderPath & FileName)

Set ws = wb.Sheets(1)

Set rng = ws.Range("A2", ws.Range("A" & ws.Rows.Count).End(xlUp))
'chèn thoi gian
With rng.Offset(, 7)

.Formula = "=((G2/1000000)+25200)/86400+25569"

.Resize(, 2).NumberFormat = "YYYY-MM-DD hh:mm:ss"
.Value = .Value
.Offset(, 1).Value = .Value

End With

'chen so thu tu

ws.Range("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

rng.Formula = "=row()-1"

rng.Offset(, 1).Value = 1

'xoa cot k can lay va chen header

ws.Range("F:H").Delete Shift:=xlToLeft

ws.Range("A1:G1").Value = headers
'xóa trùng lay 2 dong
With rng.Offset(0, 7)
.Formula = "=IF(COUNTIF(F$2:F2,F2)>2,""d"",1)"
.SpecialCells(xlCellTypeFormulas, 2).EntireRow.Delete
.ClearContents
End With

wb.Close SaveChanges:=True 'False

End Sub
-------------------------------------------------------------------------------------------------------------

dinh dang thoi gian
Sub MyFormatMacro()

Application.ScreenUpdating = False

Dim myFolder As String
Dim myFile As String
Dim wb As Workbook

' Designate folder to loop through
myFolder = "C:\Users\Admin\Desktop\ABC"
If Right(myFolder, 1) <> "\" Then myFolder = myFolder & "\"

' Loop through all Excel files in folder
myFile = Dir(myFolder & "*.xls*")
Do While myFile <> ""
Set wb = Workbooks.Open(FileName:=myFolder & myFile)
' Format column A
wb.Worksheets(1).Columns("A:A").NumberFormat = "yyyy-mm-dd hh:mm:ss"
' Save and close workbook
wb.Close SaveChanges:=True
' Get next file name
myFile = Dir
Loop

' Loop through all CSV files in folder
myFile = Dir(myFolder & "*.csv")
Do While myFile <> ""
Set wb = Workbooks.Open(FileName:=myFolder & myFile)
' Format column A
wb.Worksheets(1).Columns("A:A").NumberFormat = "yyyy-mm-dd hh:mm:ss"
' Save and close workbook
wb.Close SaveChanges:=True
' Get next file name
myFile = Dir
Loop

Application.ScreenUpdating = True

MsgBox "Macro complete!"

End Sub
 

Some videos you may like

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.

Watch MrExcel Video

Forum statistics

Threads
1,113,980
Messages
5,545,322
Members
410,676
Latest member
M0J0jojo
Top