尝试循环文件并修改和保存时出错

时间:2016-07-08 17:17:42

标签: excel vbscript

我正在编写一个VBScript文件,它将所有Excel xlsx文件放在特定文件夹中并修改内容并将其保存为制表符分隔的文本文件 - 这部分我已经工作并且可以一次执行1个文件

我似乎无法工作的是循环代码来处理该目录中的所有xlsx文件 - 而不是代码处理第一个文件 - 然后抛出一条错误消息说

  

Microsoft Excel无法访问该文件

然后只完成第一个文件。

strPath = "Y:\HUN-CHANNELS\Sales\ASRUN\WOMM_ASRUN_PARSER"

Const FromValue = ":"
Const ToValue = ""
strSafeDate = Right("0" & DatePart("d",Date), 2) & _
              Right("0" & DatePart("m",Date), 2) & DatePart("yyyy",Date) & _
              Right("0" & Hour(Now()),2) & Right("0" & Minute(Now()),2)

Dim objXL, objWB, objWS
Dim objCHNID

Set WshShell = CreateObject("WScript.Shell")
Set objXL = CreateObject("Excel.Application")

Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFso.GetFolder(strPath)

For Each objFile In objFolder.Files
  If objFso.GetExtensionName(objFile.Path) = "xlsx" Then
    Set objWB = objXL.Workbooks.Open(objFile.Path)
    Set objWS = objWB.Worksheets("ZZESSSPOTASRUNREPORT")

    objCHNID = objWS.Cells(3, 5).Value

    'Delete the first 2 rows (header rows)
    objWS.Rows("1:2").Delete

    'Format olumns B & C to 8 characters long so there are leading zeroes
    objWS.Columns(2).NumberFormat="00000000"
    objWS.Columns(3).NumberFormat="00000000"
    'Remove any Colons from Columns B & C 
    objWS.Columns(2).Replace FromValue, ToValue
    objWS.Columns(3).Replace FromValue, ToValue

    objWB.SaveAs "Y:\HUN-CHANNELS\Sales\ASRUN\WOMM_ASRUN_PARSER\REC" & _
      objCHNID & strSafeDate & ".txt", -4158
    objXL.DisplayAlerts = False
    objWB.Close
    objXL.Quit

    Set objWS = Nothing
    Set objWB = Nothing

    Set WshShell = Nothing
  End If
Next

Set objXL = Nothing

0 个答案:

没有答案