vbs 파일 복사 스 크 립 트
parentfolder = "c:\"
sourcefile = "c:\windows\log.log"
targetfolder = parentfolder & date & "\"
set objshell = createobject("shell.application")
set objfolder = objshell.namespace(parentfolder)
objfolder.newfolder date
set so=createobject("scripting.filesystemobject")
so.getfile(sourcefile).copy(targetfolder)
최근 의 수 요 를 통 해 다음 과 같은 코드 를 썼 습 니 다.파일 의 업데이트 여 부 를 판단 할 수 있 고 파일 크기 가 더 큽 니 다
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
set fn2=fso.GetFile("c:\index2.htm")
flsize2=fn2.size
fldate2=fn2.datelastmodified
set fn=fso.GetFile("c:\index.htm")
flsize1=fn.size
fldate1=fn.datelastmodified
If fso.FileExists("c:\index2.htm") and flsize2>50000 and fldate2>fldate1 Then
fso.getfile("c:\index2.htm").copy("c:\index.htm")
if err.number=0 then WriteHistory " "&now(),"log.txt"
end if
Sub WriteHistory(hisChars, path)
Const ForReading = 1, ForAppending = 8
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile(path, ForAppending, True)
f.WriteLine hisChars
f.Close
End Sub
다음은 더 많은 기능 을 가 진 코드 입 니 다
WScript.Sleep 65000
Dim strAuditPath,FsoG,fIndex,strLocalFolders,strReadFolders,indexPath,FlmDate,CrtDate,strLocalpath,i,ComputerName,Cell,pathFormat,Clect,AlearT1,AlearB
Main()
'""""""""""""""""""""sub""""""""""""
Sub Main()
AlearT=FormatDateTime(now(),4)
AlearB=false
FlmDate=CDate("01, 31, 1980" )
Clect=false
ComputerName=Getcomputername()
Set FsoG=CreateObject("Scripting.FileSystemObject")
GetSetting
'pathFormat=Left(strLocalpath,Len(strLocalpath)-8) & "Labels"
indexPath=strAuditPath & "Index.txt"
set f=FSOG.OPENTEXTFILE(GetAbPath(strAuditPath) & "logo history.txt",8,true)
f.writeline FormatDateTime(Now(),4) & "\" & cell & "\" & computername
f.close
'*************** FORMAT****************************************************************************
' Getformat
'**************************************************************************************************************
'
do while(1)
If (fsoG.FileExists(indexPath)) Then
'
set fIndex=fsoG.GetFile(indexPath)
CrtDate=fIndex.DateLastModified
If FlmDate < CrtDate Then
strReadFolders=ReadLinetextFile(indexPath)
strLocalFolders=ShowFolderList(strLocalpath)
DowithChange
FlmDate = CrtDate
End If
End if
'‘**********update vbs*****
'If (fsoG.FileExists(getAbpath(strAuditPath) & "pe.vbs")) Then
'fsog.CopyFile getAbpath(strAuditPath) & "pe.vbs",GetAbpath(GetCPath) & "pe.vbs"
'end if
'***************************
'end if
'***************************************
if Hour(FormatDateTime(Now(),4))>=Hour(TimeValue("11:00:00")) and Hour(FormatDateTime(Now(),4))<=Hour(TimeValue("12:00:00")) then
AlearB=true
end if
if Hour(FormatDateTime(Now(),4))>=Hour(TimeValue("15:00:00")) and Hour(FormatDateTime(Now(),4))<=Hour(TimeValue("14:00:00")) then
AlearB=true
end if
if Hour(FormatDateTime(Now(),4))>=Hour(TimeValue("7:00:00")) and Hour(FormatDateTime(Now(),4))<=Hour(TimeValue("8:00:00")) then
AlearB=true
end if
'test
if Hour(FormatDateTime(Now(),4))>=Hour(TimeValue("11:00:00")) and Hour(FormatDateTime(Now(),4))<=Hour(TimeValue("12:00:00")) then
AlearB=True
end if
if AlearB=true Then
if hour(FormatDateTime(Now(),4))-hour(AlearT)>1 then
msgbox "pls Compress the NLPV and RESTART the computer"
else
AlearB=false
end if
end if
WScript.Sleep 10000
Loop
End Sub
Sub Getformat()
strFormats=ShowFilesList(pathFormat)
Const ForReading = 1, ForWriting = 2
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile(GetAbPath(strAuditPath) & CELL & " " & ComputerName & ".txt", ForWriting, True)
for i=0 to UBound(strFormats)
f.WriteLine left(strFormats(i),len(strFormats(i))-4)
next
f.WriteLine cell
f.WriteLine ComputerName
'
f.Close
clect =true
End sub
Function ShowFilesList(folderspec)
Dim fso, f, f1, s(), sf,i
i=0
redim s(i)
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(folderspec)
Set fc = f.Files
For Each f1 in fc
redim Preserve s(i)
s(i)= f1.name
i=i+1
Next
ShowFilesList=s
End Function
Function ShowFolderList(folderspec)
Dim fso, f, f1, s(), sf,i
i=0
redim s(i)
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(folderspec)
Set sf = f.SubFolders
For Each f1 in sf
redim Preserve s(i)
s(i)= f1.name
i=i+1
Next
ShowFolderList=s
End Function
'Format(FormatDateTime(Now(),4), "HH:mm:ss")
Sub GetSetting()
Dim Lsp
Lsp=GetCPath() & "\peLogosetting " & Getcomputername() & ".txt"
If (Not fsoG.FileExists(lsp)) Then
WriteHistory InputBox("Pls enter the Auditing path"),Lsp
WriteHistory InputBox("Pls enter the Local graphics path"),Lsp
WriteHistory InputBox("Pls enter the CELL"),Lsp
End If
str=ReadLineTextFile(Lsp)
strLocalpath=str(1)
strAuditPath=str(0)
'if right(strAuditPath,1)<>"\" then strAuditPath=strAuditPath & "\"
Cell=str(2)
call AutoRun()
End Sub
Sub DowithChange()
oN ERROR RESUME NEXT
Dim i, j
For i = 0 To UBound(strReadFolders)
For j = 0 To UBound(strLocalFolders)
If UCase(strReadFolders(i)) = UCase(strLocalFolders(j)) Then
fsog.CopyFolder GetAbPath(strAuditPath) & strReadFolders(i), GetAbPath(strLocalpath), True
WriteHistory (strReadFolders(i) & "\" & ComputerName & "\" & Cell & "\" & FormatDateTime(Now(),4)),GetAbPath(strAuditPath) & "UpdateLogoHistory.txt"
End If
Next
Next
End Sub
Sub WriteHistory(hisChars, path)
Const ForReading = 1, ForAppending = 8
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile(path, ForAppending, True)
f.WriteLine hisChars
f.Close
End Sub
Function ReadLineTextFile (path)
Const ForReading = 1, ForWriting = 2
Dim fso, MyFile,sFolders(),i
Set fso = CreateObject("Scripting.FileSystemObject")
i=0
redim sfolders(i)
Set MyFile = fso.OpenTextFile(path, ForReading)
Do While MyFile.AtEndOfLine <> True
redim Preserve sFolders(i)
sFolders(i) = MYfile.ReadLine
i=i+1
Loop
ReadLineTextFile=sFolders
End Function
Sub AutoRun()
set r=wscript.createobject("wscript.shell")
yuan = WScript.ScriptFullName
r.RegWrite "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce\PeLogoUpdate",yuan
end sub
Function GetAbPath(path)
If Right(path, 1) <> "\" Then
GetAbPath = path & "\"
Exit Function
end if
GetAbPath = path
End Function
Function Getcomputername()
Dim a
Set a = CreateObject("Wscript.Network")
Getcomputername= a.ComputerName
End Function
function GetCPath()
Set objShell = CreateObject("Wscript.Shell")
strPath = Wscript.ScriptFullName
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.GetFile(strPath)
Getcpath = objFSO.GetParentFolderName(objFile)
end Function
vbs 복사 폴 더폴 더 복사 기능 이 필요 합 니 다.인터넷 에서 관련 코드 를 찾 고 개선 하 였 습 니 다.vbs 스 크 립 트 는 다음 과 같 습 니 다.
Dim fso, CopyCount
Set fso = CreateObject("Scripting.FileSystemObject")
CopyCount = CopyCount + XCopy(fso, ".\1", ".\2", True)
MsgBox " " & CopyCount & " !"
'********************************************************************
'* Function : XCopy
'*
'* Purpose: 。
'*
'* Input: fso FileSystemObject
'* source 。
'* destination / 。
'* overwrite 。 Ture , False
'*
'* Output:
'*
'********************************************************************
Function XCopy(fso, source, destination, overwrite)
Dim s, d, f, l, CopyCount
Set s = fso.GetFolder(source)
If Not fso.FolderExists(destination) Then
fso.CreateFolder destination
End If
Set d = fso.GetFolder(destination)
CopyCount = 0
For Each f In s.Files
l = d.Path & "\" & f.Name
If Not fso.FileExists(l) Or overwrite Then
If fso.FileExists(l) Then
fso.DeleteFile l, True
End If
f.Copy l, True
CopyCount = CopyCount + 1
End If
Next
For Each f In s.SubFolders
CopyCount = CopyCount + XCopy(fso, f.Path, d.Path & "\" & f.Name, overwrite)
Next
XCopy = CopyCount
End Function
스 크 립 트 파일 경로 에 폴 더 를 만 들 고 이름 을 짓 고 두 파일 을 넣 습 니 다.프로그램 결 과 는 다음 과 같 습 니 다
이 내용에 흥미가 있습니까?
현재 기사가 여러분의 문제를 해결하지 못하는 경우 AI 엔진은 머신러닝 분석(스마트 모델이 방금 만들어져 부정확한 경우가 있을 수 있음)을 통해 가장 유사한 기사를 추천합니다:
벚꽃 편집기가 여러 개의 매크로 논리를 하나의 파일로 정리하는 방법 2에서 설명한 방법에는 Editor 객체에 액세스할 수 없는 치명적인 문제가 있습니다. 다른 방법을 생각해 봤어요. 본체의 파일include를 포장용 vbs 파일에 넣기 본체 샘플 Test.vbs 포장용 서류의 샘플 ...
텍스트를 자유롭게 공유하거나 복사할 수 있습니다.하지만 이 문서의 URL은 참조 URL로 남겨 두십시오.
CC BY-SA 2.5, CC BY-SA 3.0 및 CC BY-SA 4.0에 따라 라이센스가 부여됩니다.