Xin giúp code kiểm tra file xls có tồn tại ko? nếu có Save as xlsx và xóa file gốc

Liên hệ QC
P

phanminhphuong

Thành viên hoạt động
Tham gia
26/7/13
Bài viết
127
Được thích
68
Mình có file D:\DATA\test.xls
vậy phải viết code ntn cho file test.xls để:
1) kiểm tra trong Folder DATA có file Template.xls ko?
2) nếu có thì save as thành Template.XLSX + xóa file Template.xls & Nếu Folder DATA đã có file Template.XLSX thì khi Save as cũng xóa luôn file này (tức là save as thành xlsx & ghi đè nếu có - ko hiện yêu cầu xác nhận)
Code ntn để hạn chế tối đa lỗi.
Tks
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
phanminhphuong đã viết:
Mình có file D:\DATA\test.xls
vậy phải viết code ntn cho file test.xls để:
1) kiểm tra trong Folder DATA có file Template.xls ko?
2) nếu có thì save as thành Template.XLSX + xóa file Template.xls & Nếu Folder DATA đã có file Template.XLSX thì khi Save as cũng xóa luôn file này (tức là save as thành xlsx & ghi đè nếu có - ko hiện yêu cầu xác nhận)
Code ntn để hạn chế tối đa lỗi.
Tks
Nhấp chuột vào đây để mở rộng...

Chào bạn!

Code này chắc đáp ứng được yêu cầu của bạn (cho code vào 1 module file Test.xls và chạy thử)
PHP: 
Sub Save_as_xlsx()

Dim fso As Object, sPath As String
Set fso = CreateObject("Scripting.FileSystemObject")
sPath = ThisWorkbook.Path 'Hoặc thay = đường dẫn khác

  With fso
      If .FileExists(sPath & "\" & "Template.xls") Then
      Workbooks.Open sPath & "\" & "Template.xls"
      Application.DisplayAlerts = False
          ActiveWorkbook.SaveAs Filename:=sPath & "\" & "Template.xlsx" _
                                , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
          Kill sPath & "\" & "TemplateHQ.xls"
      Application.DisplayAlerts = True
      End If
  End With

Set fso = Nothing
'Application.Quit

End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
otonhot đã viết:
Chào bạn!

Code này chắc đáp ứng được yêu cầu của bạn (cho code vào 1 module file Test.xls và chạy thử)
PHP: 
Sub Save_as_xlsx()

Dim fso As Object, sPath As String
Set fso = CreateObject("Scripting.FileSystemObject")
sPath = ThisWorkbook.Path 'Hoặc thay = đường dẫn khác

  With fso
      If .FileExists(sPath & "\" & "Template.xls") Then
      Workbooks.Open sPath & "\" & "Template.xls"
      Application.DisplayAlerts = False
          ActiveWorkbook.SaveAs Filename:=sPath & "\" & "Template.xlsx" _
                                , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
          Kill sPath & "\" & "TemplateHQ.xls"
      Application.DisplayAlerts = True
      End If
  End With

Set fso = Nothing
'Application.Quit

End Sub
Nhấp chuột vào đây để mở rộng...

Hinh như không đúng yêu cầu của tác giả thì phải
Theo như tôi hiểu thì không cần Workbooks.Open gì cả mà chỉ là:
- Save As file Test.xls thành file Template.xlsx (ghi đè nếu file Template.xlsx tồn tại)
- Xóa file Template.xls nếu nó tồn tại
Chỉ thế thôi
 
Upvote 0
ndu96081631 đã viết:
Hinh như không đúng yêu cầu của tác giả thì phải
Theo như tôi hiểu thì không cần Workbooks.Open gì cả mà chỉ là:
- Save As file Test.xls thành file Template.xlsx (ghi đè nếu file Template.xlsx tồn tại)
- Xóa file Template.xls nếu nó tồn tại
Chỉ thế thôi
Nhấp chuột vào đây để mở rộng...

Mình có đọc kỹ bài 1 mới làm mà. câu 2 có ý là Nếu file Template.xls có thì Save as phải không tác giả? tức là file Test.xls chỉ là file trung gian để chạy code (có thể file Template.xls tác giả copy từ đâu đó)
phanminhphuong đã viết:
Mình có file D:\DATA\test.xls
vậy phải viết code ntn cho file test.xls để:
1) kiểm tra trong Folder DATA có file Template.xls ko?
2) nếu có thì save as thành Template.XLSX + xóa file Template.xls & Nếu Folder DATA đã có file Template.XLSX thì khi Save as cũng xóa luôn file này (tức là save as thành xlsx & ghi đè nếu có - ko hiện yêu cầu xác nhận)
Nhấp chuột vào đây để mở rộng...
Nhân tiện các bạn cho hỏi có cách nào nữa không ạ, mà có thể ngắn gọn hơn?
 
Lần chỉnh sửa cuối:
Upvote 0
ndu96081631 đã viết:
Hinh như không đúng yêu cầu của tác giả thì phải
Theo như tôi hiểu thì không cần Workbooks.Open gì cả mà chỉ là:
- Save As file Test.xls thành file Template.xlsx (ghi đè nếu file Template.xlsx tồn tại)
- Xóa file Template.xls nếu nó tồn tại
Chỉ thế thôi
Nhấp chuột vào đây để mở rộng...

Hình như cách của Ndu không được, không thể chỉ đổi đuôi mà từ Exc2003 thành Exc2007 được. Theo mình trình tự phải như thế này:

-Kiểm tra Phiên bản của Exc nếu Exc2003 đổ lại thì báo và thoát luôn vì có kiểm tra cũng không lưu được.

-Xoá file D:\DATA\template.xls

-Mở file D:\DATA\test.xls bằng phiên bản thích hợp và save as lại thành D:\DATA\template.xlsx

(Mình đoán vậy, nhưng cũng có thể với file nguồn tạo bằng Exc2003 thì đương nhiên 2007 phải đọc được và có thể, tốt nhất là đổi đuôi thử và mở file xem sao. Tiếc rằng mình không cài 2007 nên không Test đươc)
 
Lần chỉnh sửa cuối:
Upvote 0
sealand đã viết:
Hình như cách của Ndu không được, không thể chỉ đổi đuôi mà từ Exc2003 thành Exc2007 được. Theo mình trình tự phải như thế này:

-Kiểm tra Phiên bản của Exc nếu Exc2003 đổ lại thì báo và thoát luôn vì có kiểm tra cũng không lưu được.

-Xoá file D:\DATA\template.xls

-Mở file D:\DATA\test.xls bằng phiên bản thích hợp và save as lại thành D:\DATA\template.xlsx
Nhấp chuột vào đây để mở rộng...

Cần gì kiểm tra phiên bản chứ anh?
Tác giả đề cập đến việc Save As thành XLSX, có nghĩa là họ đã có chương trình để mở file XLSX rồi (Excel 2007 hoặc Excel 2010) ---> Lý nào file XLSX chỉ nằm đó để... chơi chơi
 
Upvote 0
sealand đã viết:
Hình như cách của Ndu không được, không thể chỉ đổi đuôi mà từ Exc2003 thành Exc2007 được. Theo mình trình tự phải như thế này:

-Kiểm tra Phiên bản của Exc nếu Exc2003 đổ lại thì báo và thoát luôn vì có kiểm tra cũng không lưu được.

-Xoá file D:\DATA\template.xls

-Mở file D:\DATA\test.xls bằng phiên bản thích hợp và save as lại thành D:\DATA\template.xlsx
Nhấp chuột vào đây để mở rộng...
Ui xin lỗi mọi người tại ý 2 mình viết thiếu làm mọi người hiểu nhầm
Nói rõ là thế này:
1) Mình có Folder D:\DATA
2) Trong Folder đó mình có sẵn file Test.xls (và đúng như otonhot nói đây chỉ là file trung gian để chứa code)
3) Code (trong Test.xls) thực hiện các công việc
- Kiểm tra trong folder DATA có Template.xls chưa
- Nếu có Template.xls thì Save as nó thành Template.xlsx. Rồi xóa file Template.xls
Khi Save as mà trong Folder DATA cũng có file Template.XLSX từ trước thì ghi đè luôn không hiện bảng hỏi xác nhận
MANY TKS
 
Upvote 0
phanminhphuong đã viết:
Ui xin lỗi mọi người tại ý 2 mình viết thiếu làm mọi người hiểu nhầm
Nói rõ là thế này:
1) Mình có Folder D:\DATA
2) Trong Folder đó mình có sẵn file Test.xls (và đúng như otonhot nói đây chỉ là file trung gian để chứa code)
3) Code (trong Test.xls) thực hiện các công việc
- Kiểm tra trong folder DATA có Template.xls chưa
- Nếu có Template.xls thì Save as nó thành Template.xlsx. Rồi xóa file Template.xls
Khi Save as mà trong Folder DATA cũng có file Template.XLSX từ trước thì ghi đè luôn không hiện bảng hỏi xác nhận
MANY TKS
Nhấp chuột vào đây để mở rộng...
Code của otonhot bài 2 vừa kiểm tra chạy ok nhưng bây giờ mình lại có vđề thế này:
Nếu viết code cho file Word: Test.doc cũng thực hiện công việc như trên thì làm như thế nào đây? nhờ mọi người chỉ giúp
 
Upvote 0
ndu96081631 đã viết:
Hinh như không đúng yêu cầu của tác giả thì phải
Theo như tôi hiểu thì không cần Workbooks.Open gì cả mà chỉ là:
- Save As file Test.xls thành file Template.xlsx (ghi đè nếu file Template.xlsx tồn tại)
- Xóa file Template.xls nếu nó tồn tại
Chỉ thế thôi
Nhấp chuột vào đây để mở rộng...
Theo thầy không cần mở file lên có chuyển được định dạng xls sang xlsx không ạ
Em đã test thử code của bạn Otonhot thấy chuyển được định dạng nhưng trước khi chuyển mà mở file lên thì khác gì mở file lên rồi nhấn F12 chọn định dạng lại
 
Upvote 0
phanminhphuong đã viết:
Code của otonhot bài 2 vừa kiểm tra chạy ok nhưng bây giờ mình lại có vđề thế này:
Nếu viết code cho file Word: Test.doc cũng thực hiện công việc như trên thì làm như thế nào đây? nhờ mọi người chỉ giúp
Nhấp chuột vào đây để mở rộng...

Viết thử cho bạn như thế này nhưng chưa được. Báo lỗi Object Require chỗ màu đỏ, vậy phải sửa làm sao? mọi người góp ý giúp
Mã: 
Sub test()
Dim oExcel as Object, sPath as String
Set oExcel = CreateObject("EXCEL.APPLICATION")
sPath = ThisDocument.Path

With CreateObject("Scripting.FileSystemObject")
  If .FileExists(sPath & "\" & "Template.xlsx") Then
      Kill sPath & "\" & "Template.xlsx"
  End If
      If .FileExists(sPath & "\" & "Template.xls") Then
        oExcel.Workbooks.Open (sPath & "\" & "Template.xls")
        [COLOR=#ff0000]ActiveWorkbooks.[/COLOR]SaveAs FileName:=sPath & "\" & "Template.xlsx" _
                                , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        Kill sPath & "\" & "Template.xls"
      End If
End With
Set oExcel = Nothing
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
otonhot đã viết:
Viết thử cho bạn như thế này nhưng chưa được. Báo lỗi Object Require chỗ màu đỏ, vậy phải sửa làm sao? mọi người góp ý giúp
Mã: 
Sub test()
Dim oExcel as Object, sPath as String
Set oExcel = CreateObject("EXCEL.APPLICATION")
sPath = ThisDocument.Path

With CreateObject("Scripting.FileSystemObject")
  If .FileExists(sPath & "\" & "Template.xlsx") Then
      Kill sPath & "\" & "Template.xlsx"
  End If
      If .FileExists(sPath & "\" & "Template.xls") Then
        oExcel.Workbooks.Open (sPath & "\" & "Template.xls")
        [COLOR=#ff0000]ActiveWorkbooks.[/COLOR]SaveAs FileName:=sPath & "\" & "Template.xlsx" _
                                , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        Kill sPath & "\" & "Template.xls"
      End If
End With
Set oExcel = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...

Sửa thành vầy nhé:
Mã: 
Sub test()
Dim sPath As String
sPath = [COLOR=#ff0000]ThisWorkbook.Path[/COLOR]

With CreateObject("Scripting.FileSystemObject")
  If .FileExists(sPath & "\" & "Template.xlsx") Then
      Kill sPath & "\" & "Template.xlsx"
  End If
      If .FileExists(sPath & "\" & "Template.xls") Then
        Workbooks.Open (sPath & "\" & "Template.xls")
        [COLOR=#ff0000]ActiveWorkbook[/COLOR].SaveAs Filename:=sPath & "\" & "Template.xlsx" _
                                , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        Kill sPath & "\" & "Template.xls"
      End If
End With
Set oExcel = Nothing
End Sub
Chổ màu đỏ là những chổ sửa lại
Vì code chạy trên Excel nên không cần động tác Set oExcel = CreateObject("EXCEL.APPLICATION") đâu
Còn tôi thì viết vầy:
Mã: 
Sub Main()
  Dim fso As Object
  Dim strFile As String
  On Error Resume Next
  strFile = ThisWorkbook.Path & "\Template.xls"
  Set fso = CreateObject("Scripting.FileSystemObject")
  If fso.FileExists(strFile) Then
    Application.ScreenUpdating = False
    With Workbooks.Open(strFile)
      Application.DisplayAlerts = False
      .SaveAs strFile & "x", xlOpenXMLWorkbook
      .Close True
      fso.DeleteFile strFile
      Application.DisplayAlerts = True
    End With
    MsgBox "Done!"
  Else
    MsgBox "File '" & strFile & "' does not exist"
  End If
  Application.ScreenUpdating = True
  Set fso = Nothing
End Sub
 
Upvote 0
ndu96081631 đã viết:
Sửa thành vầy nhé:
Mã: 
Sub test()
Dim sPath As String
sPath = [COLOR=#ff0000]ThisWorkbook.Path[/COLOR]

With CreateObject("Scripting.FileSystemObject")
  If .FileExists(sPath & "\" & "Template.xlsx") Then
      Kill sPath & "\" & "Template.xlsx"
  End If
      If .FileExists(sPath & "\" & "Template.xls") Then
        Workbooks.Open (sPath & "\" & "Template.xls")
        [COLOR=#ff0000]ActiveWorkbook[/COLOR].SaveAs Filename:=sPath & "\" & "Template.xlsx" _
                                , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        Kill sPath & "\" & "Template.xls"
      End If
End With
Set oExcel = Nothing
End Sub
Chổ màu đỏ là những chổ sửa lại
Vì code chạy trên Excel nên không cần động tác Set oExcel = CreateObject("EXCEL.APPLICATION") đâu
Còn tôi thì viết vầy:
Mã: 
Sub Main()
  Dim fso As Object
  Dim strFile As String
  On Error Resume Next
  strFile = ThisWorkbook.Path & "\Template.xls"
  Set fso = CreateObject("Scripting.FileSystemObject")
  If fso.FileExists(strFile) Then
    Application.ScreenUpdating = False
    With Workbooks.Open(strFile)
      Application.DisplayAlerts = False
      .SaveAs strFile & "x", xlOpenXMLWorkbook
      .Close True
      fso.DeleteFile strFile
      Application.DisplayAlerts = True
    End With
    MsgBox "Done!"
  Else
    MsgBox "File '" & strFile & "' does not exist"
  End If
  Application.ScreenUpdating = True
  Set fso = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Có lẽ ndu96081631 chưa đọc bài #8 mà phanminhphuong có 1 yêu cầu khác là viết Code VBA cho Test.doc (file Word) chứ không phải Test.xls
Chính vì vậy code trong Test.doc mới có đoạn Set oExcel = CreateObject("EXCEL.APPLICATION") tuy nhiên sau đó mình không biết code save as viết trong word ntn để tác động lên file Template.xls đó (sau khi mở ra). Mong mọi người góp ý...
 
Lần chỉnh sửa cuối:
Upvote 0
otonhot đã viết:
Có lẽ ndu96081631 chưa đọc bài #8 mà phanminhphuong có 1 yêu cầu khác là viết Code VBA cho Test.doc (file Word) chứ không phải Test.xls
Chính vì vậy code trong Test.doc mới có đoạn Set oExcel = CreateObject("EXCEL.APPLICATION") tuy nhiên sau đó mình không biết code save as viết trong word ntn để tác động lên file Template.xls đó (sau khi mở ra). Mong mọi người góp ý...
Nhấp chuột vào đây để mở rộng...

Nếu vậy thì sửa thành vầy:
Mã: 
Sub test()
  Dim oExcel As Object, sPath As String
  Set oExcel = CreateObject("EXCEL.APPLICATION")
  sPath = ThisDocument.Path
  With CreateObject("Scripting.FileSystemObject")
    If .FileExists(sPath & "\" & "Template.xlsx") Then
      .DeleteFile sPath & "\" & "Template.xlsx"
    End If
    If .FileExists(sPath & "\" & "Template.xls") Then
      [COLOR=#ff0000]With oExcel.Workbooks.Open(sPath & "\" & "Template.xls")
        .SaveAs sPath & "\Template.xlsx", 51
        .Close True
      End With[/COLOR]
      .DeleteFile sPath & "\" & "Template.xls"
    End If
  End With
  Set oExcel = Nothing
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
ndu96081631 đã viết:
Nếu vậy thì sửa thành vầy:
Mã: 
Sub test()
  Dim oExcel As Object, sPath As String
  Set oExcel = CreateObject("EXCEL.APPLICATION")
  sPath = ThisDocument.Path
  With CreateObject("Scripting.FileSystemObject")
    If .FileExists(sPath & "\" & "Template.xlsx") Then
      .DeleteFile sPath & "\" & "Template.xlsx"
    End If
    If .FileExists(sPath & "\" & "Template.xls") Then
      [COLOR=#ff0000]With oExcel.Workbooks.Open(sPath & "\" & "Template.xls")
        .SaveAs sPath & "\Template.xlsx", 51
        .Close True
      End With[/COLOR]
      .DeleteFile sPath & "\" & "Template.xls"
    End If
  End With
  Set oExcel = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Code chạy ngon. Tks bạn nhiều
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

trantrimmo
Xin code VBA xuất pdf từ 3 sheet theo lấy thông tin theo tên sheet ạ.
Trả lời
1
Đọc
85
dangvandang
dangvandang
LuuAnh980
  • Question
Code lấy dữ liệu từ 3 file con.
Trả lời
17
Đọc
199
LuuAnh980
LuuAnh980
B
  • Question
Chuyển đổi dữ liệu sạng dạng mảng
Trả lời
6
Đọc
101
HieuCD
H
S
Nhờ giúp đỡ code in toàn bộ danh sách có điều kiện
Trả lời
6
Đọc
143
Hoàng Tuấn 868
H
S
  • Question
Không lấy đủ dữ liệu bằng kết nối ADO
Trả lời
0
Đọc
65
shnhatha221108
S
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom