Nguyen Anh Dung
Board Regular
- Joined
- Feb 28, 2020
- Messages
- 180
- Office Version
- 2016
- Platform
- 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")
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