Tắt cửa sổ Application.FileDialog(msoFileDialogFolderPicker)

[phamvandunghp84]

Chào các anh chị và các bạn trên diễn đàn. Tôi gặp khó khăn trong việc này mong được các anh chị và các bạn giải đáp:
Tôi muốn chuyển tất cả file CSV trong 1 thư mục sang file xlsx nhưng không muốn hiển thị cửa sổ chọn foder
tôi đang thử code này nhưng vẫn không được:
( mong muốn của tôi là khi chạy VBA này không phải lựa chọn thư mục nữa mà chạy thẳng luôn)

Sub CSVTOXLSX()
'UpdatebyExtendoffice20170814
Dim xFd As FileDialog
Dim xSPath As String
Dim xCSVFile As String
Dim xWsheet As String
InitialFoldr$ = "C:\Users\Downloads\"

Application.DisplayAlerts = False
Application.StatusBar = True
xWsheet = ActiveWorkbook.Name

With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = InitialFoldr$
End With

Set xFd = Application.FileDialog(msoFileDialogFolderPicker)

If xFd.Show = -1 Then
xSPath = xFd.SelectedItems(1)
Else
Exit Sub
End If
If Right(xSPath, 1) <> "\" Then xSPath = xSPath + "\"
xCSVFile = Dir(xSPath & "*.csv")
Do While xCSVFile <> ""
Application.StatusBar = "Converting: " & xCSVFile
Workbooks.Open Filename:=xSPath & xCSVFile
ActiveWorkbook.SaveAs Replace(xSPath & xCSVFile, ".csv", ".xlsx", vbTextCompare), xlWorkbookDefault
ActiveWorkbook.Close
Windows(xWsheet).Activate
xCSVFile = Dir
Loop
Application.StatusBar = False
Application.DisplayAlerts = True
End Sub

 

[ppc0312]

Chào các anh chị và các bạn trên diễn đàn. Tôi gặp khó khăn trong việc này mong được các anh chị và các bạn giải đáp:
Tôi muốn chuyển tất cả file CSV trong 1 thư mục sang file xlsx nhưng không muốn hiển thị cửa sổ chọn foder
tôi đang thử code này nhưng vẫn không được:
( mong muốn của tôi là khi chạy VBA này không phải lựa chọn thư mục nữa mà chạy thẳng luôn)

Sub CSVTOXLSX()
'UpdatebyExtendoffice20170814
Dim xFd As FileDialog
Dim xSPath As String
Dim xCSVFile As String
Dim xWsheet As String
InitialFoldr$ = "C:\Users\Downloads\"

Application.DisplayAlerts = False
Application.StatusBar = True
xWsheet = ActiveWorkbook.Name

With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = InitialFoldr$
End With

Set xFd = Application.FileDialog(msoFileDialogFolderPicker)

If xFd.Show = -1 Then
xSPath = xFd.SelectedItems(1)
Else
Exit Sub
End If
If Right(xSPath, 1) <> "\" Then xSPath = xSPath + "\"
xCSVFile = Dir(xSPath & "*.csv")
Do While xCSVFile <> ""
Application.StatusBar = "Converting: " & xCSVFile
Workbooks.Open Filename:=xSPath & xCSVFile
ActiveWorkbook.SaveAs Replace(xSPath & xCSVFile, ".csv", ".xlsx", vbTextCompare), xlWorkbookDefault
ActiveWorkbook.Close
Windows(xWsheet).Activate
xCSVFile = Dir
Loop
Application.StatusBar = False
Application.DisplayAlerts = True
End Sub

thì xóa hết đoạn này

Sub CSVTOXLSX()
'UpdatebyExtendoffice20170814
Dim xFd As FileDialog
Dim xSPath As String
Dim xCSVFile As String
Dim xWsheet As String
InitialFoldr$ = "C:\Users\Downloads\"

Application.DisplayAlerts = False
Application.StatusBar = True
xWsheet = ActiveWorkbook.Name

With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = InitialFoldr$
End With

Set xFd = Application.FileDialog(msoFileDialogFolderPicker)

If xFd.Show = -1 Then
xSPath = xFd.SelectedItems(1)
Else
Exit Sub
End If

........... thay thành

Sub CSVTOXLSX()
'UpdatebyExtendoffice20170814

Dim xSPath As String, xCSVFile As String, xWsheet As String

xSPath = "C:\Users\Downloads\" 'thay thanh folder chon

Application.DisplayAlerts = False
Application.StatusBar = True
xWsheet = ActiveWorkbook.Name

 

[phamvandunghp84]

thì xóa hết đoạn này

Sub CSVTOXLSX()
'UpdatebyExtendoffice20170814
Dim xFd As FileDialog
Dim xSPath As String
Dim xCSVFile As String
Dim xWsheet As String
InitialFoldr$ = "C:\Users\Downloads\"

Application.DisplayAlerts = False
Application.StatusBar = True
xWsheet = ActiveWorkbook.Name

With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = InitialFoldr$
End With

Set xFd = Application.FileDialog(msoFileDialogFolderPicker)

If xFd.Show = -1 Then
xSPath = xFd.SelectedItems(1)
Else
Exit Sub
End If

........... thay thành

Sub CSVTOXLSX()
'UpdatebyExtendoffice20170814

Dim xSPath As String, xCSVFile As String, xWsheet As String

xSPath = "C:\Users\Downloads\" 'thay thanh folder chon

Application.DisplayAlerts = False
Application.StatusBar = True
xWsheet = ActiveWorkbook.Name

Cảm ơn bạn rất nhiều, mình đã thử ok rồi