vba2

最新推荐文章于 2021-08-04 23:20:13 发布

wentise

最新推荐文章于 2021-08-04 23:20:13 发布

阅读量283

点赞数

本文链接：https://blog.csdn.net/wentise/article/details/84280967

版权


Const adVarChar = 200
Const MaxCharacters = 40000
Const ForReading = 1
Const ForWriting = 2
Set DataList = CreateObject("ADOR.Recordset")
DataList.Fields.Append ""filed_name"", adVarChar, MaxCharacters
DataList.Open
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("C:\Documents and Settings\Administrator\桌面\复件 hsqldb-2.2.9\22.txt", ForReading)
Do Until objFile.AtEndOfStream
    strLine = objFile.ReadLine
    DataList.AddNew
    DataList(""filed_name"") = strLine
    DataList.Update
Loop
objFile.Close
DataList.Sort = ""filed_name""
DataList.MoveFirst
Do Until DataList.EOF
    strText = strText & DataList.Fields.Item(""filed_name"") & vbCrLf
    DataList.MoveNext
Loop
Set objFile = objFSO.OpenTextFile("C:\Documents and Settings\Administrator\桌面\复件 hsqldb-2.2.9\22.txt", ForWriting)
objFile.WriteLine strText
objFile.Close



Dim xlA,xlB,xlS,xlR,xlT
Set xlA = CreateObject("Excel.Application")
xlA.DisplayAlerts=False
Dim txtLine
Dim FileObj
Dim TextObj
Dim FilePath

FilePath = ".\txt.bat"
Set FileObj = CreateObject("Scripting.FileSystemObject")
Set TextObj = FileObj.OpenTextFile(FilePath)
Do While Not TextObj.AtEndOfLine
txtLine = txtLine & Trim(TextObj.ReadLine)
msgbox txtLine
Set xlB = xlA.Workbooks.Open(txtLine)
Set xlS = xlB.Worksheets(1)
Set xlR = xlS.UsedRange
Set xlT = xlA.Range("A1")
xlR.Sort(xlT)
xlB.Save
xlB.Close
Loop
MsgBox txtLin

xlA.Quit


@echo off
set DestPath="C:\Documents and Settings\Administrator\桌面\复件 hsqldb-2.2.9\新建文件夹"
set NewDestPath=.sort
set DestExt="*.*"
set SortDest="*.sort"

for /f "delims=" %%i in ('dir  /b/a-d/s  %DestPath%\%DestExt%') do (

echo copy "%%i" "%%i%NewDestPath%">>txt.bat
)
rem pause > nvl
call txt.bat
del .\txt.bat

for /f "delims=" %%i in ('dir  /b/a-d/s  %DestPath%\%SortDest%') do (

echo %%i>>txt.bat
)
pause