กระทู้เก่าบอร์ด อ.Yeadram
1,485 2
URL.หัวข้อ /
URL
ช่วยดูการ copy move Zip data ให้ผมด้วยครับ
Private Sub Command0_Click()
Dim fold
Set fold = CreateObject("Scripting.FileSystemObject")
newFDR = "C:\app\Export\data"
If Not fold.FolderExists(newFDR) Then
fold.CreateFolder (newFDR)
End If
If MsgBox("ต้องการ Zip data หรือไม่...", vbQuestion + vbOKCancel, "แจ้งผล") = vbOK Then
If Not fold.FolderExists(newFDR) Then
' ****** ต้องการ copy text ย้ายเข้า folder ที่สร้างใหม่ แต่ไม่มา ไม่รู้จะแก้ยังไงครับ
FileSystemObject.CopyFile "C:\app\Export\*.txt", "C:\app\Export\data\"
End If
Dim stAppName As String
' ******ต้องการ Zip folder ครับ ตอนนี้มัน Zip โดย นำ text มา Zip เลย
stAppName = "C:\Program Files\WinZip\WINZIP32.EXE -a -es C:\app\Export\data.zip C:\app\Export\data\*.txt"
Call Shell(stAppName, 1)
MsgBox "zip สำเร็จแล้วจ้า C:\app\Export\", vbOKOnly, "แจ้งผล"
End If
End Sub
ถ้าต้องการ rename folder ตามวันที่ที่รับค่าจาก textbox จาก form จะทำยังไงครับ โดย rename เป็น Data_20110412 แล้วค่อย ค่อยสั่ง Zip
อ. ท่านช่วยแก้ code ผมที่ครับ
Dim fold
Set fold = CreateObject("Scripting.FileSystemObject")
newFDR = "C:\app\Export\data"
If Not fold.FolderExists(newFDR) Then
fold.CreateFolder (newFDR)
End If
If MsgBox("ต้องการ Zip data หรือไม่...", vbQuestion + vbOKCancel, "แจ้งผล") = vbOK Then
If Not fold.FolderExists(newFDR) Then
' ****** ต้องการ copy text ย้ายเข้า folder ที่สร้างใหม่ แต่ไม่มา ไม่รู้จะแก้ยังไงครับ
FileSystemObject.CopyFile "C:\app\Export\*.txt", "C:\app\Export\data\"
End If
Dim stAppName As String
' ******ต้องการ Zip folder ครับ ตอนนี้มัน Zip โดย นำ text มา Zip เลย
stAppName = "C:\Program Files\WinZip\WINZIP32.EXE -a -es C:\app\Export\data.zip C:\app\Export\data\*.txt"
Call Shell(stAppName, 1)
MsgBox "zip สำเร็จแล้วจ้า C:\app\Export\", vbOKOnly, "แจ้งผล"
End If
End Sub
ถ้าต้องการ rename folder ตามวันที่ที่รับค่าจาก textbox จาก form จะทำยังไงครับ โดย rename เป็น Data_20110412 แล้วค่อย ค่อยสั่ง Zip
อ. ท่านช่วยแก้ code ผมที่ครับ
2 Reply in this Topic. Dispaly 1 pages and you are on page number 1
2 @R08824
' ****** ต้องการ copy text ย้ายเข้า folder ที่สร้างใหม่ แต่ไม่มา ไม่รู้จะแก้ยังไงครับ
----------------------------------------
DIM fi as file
dim fo as folder
set fo = fold.Getfolder("C:\app\Export\")
for each fi in fo.files
if right(lcase(fi.name),4)=".txt" then _
FileSystemObject.CopyFile fi.name, newFDR & "\" & dir(fi.name)
next
คัดลอกทั้งโฟลเดอร์ ต้องวนลูปเอานะครับ มันจะสั่ง คัดลอก * ไม่ได้นะ (ไม่แน่ใจเหมือนกัน) แต่คิดว่า โค้ดมันควรจะเป็นประมาณด้านบนนั่นแหละครับ ลองดู เผื่อเขียนผิดก็อย่าว่ากันเด้อ เขียนสดครับ ยังไม่ได้ลอง
----------------------------------------
DIM fi as file
dim fo as folder
set fo = fold.Getfolder("C:\app\Export\")
for each fi in fo.files
if right(lcase(fi.name),4)=".txt" then _
FileSystemObject.CopyFile fi.name, newFDR & "\" & dir(fi.name)
next
คัดลอกทั้งโฟลเดอร์ ต้องวนลูปเอานะครับ มันจะสั่ง คัดลอก * ไม่ได้นะ (ไม่แน่ใจเหมือนกัน) แต่คิดว่า โค้ดมันควรจะเป็นประมาณด้านบนนั่นแหละครับ ลองดู เผื่อเขียนผิดก็อย่าว่ากันเด้อ เขียนสดครับ ยังไม่ได้ลอง
Time: 0.3935s
On Error GoTo Err1
Dim fold As Object
Set fold = CreateObject("Scripting.FileSystemObject")
newFDR = "C:\app\Export\data"
If Not fold.FolderExists(newFDR) Then
fold.CreateFolder (newFDR)
End If
If MsgBox("ต้องการ Zip data หรือไม่...", vbQuestion + vbOKCancel, "แจ้งผล") = vbOK Then
Dim stAppName As String
fold.copyFile "C:\app\Export\*.txt", "C:\app\Export\data\", True
stAppName = "C:\Program Files\WinZip\WINZIP32.EXE -a -es C:\app\Export\data.zip C:\app\Export\data\*.txt"
Call Shell(stAppName, 1)
MsgBox "zip สำเร็จแล้วจ้า C:\app\Export\", vbOKOnly, "แจ้งผล"
Name "C:\app\Export\data.zip" As "C:\app\Export\data_" & txtRename & ".zip"
Name "C:\app\Export\data" As "C:\app\Export\data_" & txtRename
End If
Exit_Err1:
Exit Sub
Err1:
MsgBox "ไฟล์ข้อมูลที่ต้องการบันทึกมีอยู่แล้วครับ", vbInformation, "แจ้งให้ทราบ"
Resume Exit_Err1
End Sub
โดยที่ textbox ให้ตั้งชื่อเป็น txtRename ครับ
น่าจะได้ตรงตามต้องการ