VBS 将Txt 转成Excel，并加图片列头的处理...

'------------------------------------------------------------
'O2 Data File Transfer
'Get File type is txt, Change Transport to file type is xls 
'
'Create Date: 2008-11-11
'Author:   Wei_Zhu
'Chage Log:
'Last Chage Date:
'-------------------------------------------------------------

Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

set ws=createobject("wscript.shell")
set fso=createobject("scripting.filesystemobject")
set folder=fso.getfolder(ws.currentdirectory&"/From")

set files=folder.files
for each file in files
 ReadFile file.name,folder
 MoveFile file.name,folder
next

'-------Read Data File-----

Sub ReadFile(lstg_file,folder)
 Dim fso,f
 dim lstg_from_file
 dim lstg_f
 dim lstg_f_txt
 dim lstg_f_line
 lstg_f_ling = 0
 lstg_from_file=folder&"/"&lstg_file
 Set fso = CreateObject("Scripting.FileSystemObject")
 Set f = fso.GetFile(lstg_from_file)
 Set lstg_f = f.OpenAsTextStream(ForReading, TristateUseDefault)
 While   Not   lstg_f.atEndOfLine
  lstg_f_txt=lstg_f.readall
  lstg_f_line=lstg_f.line   'Get File Line Count
  msgbox lstg_f_line
  lstg_f_txt=Replace(lstg_f_txt,"|",Chr(9))    
    WEnd 
 TransferFile lstg_f_txt,folder,lstg_file 
End Sub

'-------Transfer Data File-----
Sub TransferFile(lstg_f_txt,folder,lstg_file)
 dim lstg_to_f
 Dim l_f
 Dim fso, f
    Set fso = CreateObject("Scripting.FileSystemObject")
 
 lstg_to_f = folder
 lstg_to_f = replace(lstg_to_f,"From","To")
 lstg_file=UCase(lstg_file)
 '---Get Report Type---
 
 if instr(lstg_file,"ATWIP")=1 then
  'msgbox "1"
  l_f = "1"
 end if
    if instr(lstg_file,"WAO")=1 then 
  'msgbox "2"
  l_f = "2"
 end if
 if instr(lstg_file,"WSC")=1 then 
  'msgbox "3"
  l_f = "3"
 end if
 if instr(lstg_file,"SFAS")=1 then 
  'msgbox "4"
  l_f = "4"
 end if
 lstg_file = replace(lstg_file,"TXT","xls")
 lstg_to_f = lstg_to_f&"/"&lstg_file
 
 Set f = fso.OpenTextFile(lstg_to_f, ForWriting, True)
    f.Write lstg_f_txt
    f.Close
 'msgbox lstg_to_f
 'msgbox lstg_f_txt

 Set objExcel = CreateObject("Excel.Application")
 'Set objWorkbook=objExcel.Workbooks.Add()    'This is add new
 Set objWorkbook=objExcel.Workbooks.Open(lstg_to_f)

 Select Case l_f
    Case "1"
     Set objRange =objExcel.Range("A1","A1") 
        objRange.EntireRow.Insert
     objRange.EntireRow.Insert 
     '---Set Title---
     Set objRange = objExcel.Range("A1","J1") 
     objRange.Font.Size = 14
     objrange.Font.Bold = True
     objrange.Font.Name  = "Times New Roman"
     objrange.Cells(1).value="Auto-WIP(SHOP FLOOR)"
     objrange.Interior.ColorIndex = 15  'Set BackColor
     objrange.MergeCells = true
     'objrange.HorizontalAlignment =  -4108
     objrange.HorizontalAlignment =  3
     objrange.Merge
         
     '---Set Header---
     'JOB PART# LOT# DEPARTMENT_CODE QUEUE_QTY RUNNING(WIP)_QTY HOLD_QTY MOVE_PASS_QTY MOVE_FAIL_QTY WAFE_PCS
   
     Set objRange = objExcel.Range("A2","J2") 
     objRange.Font.Size = 10
     objrange.Font.Bold = True
     objrange.Font.Name  = "Times New Roman"
     objrange.Cells(1).Value="JOB"
     objrange.Cells(2).Value="PART#"
     objrange.Cells(3).Value="LOT#"
     objrange.Cells(4).Value="DEPARTMENT_CODE"
     objrange.Cells(5).Value="QUEUE_QTY"
     objrange.Cells(6).Value="RUNNING(WIP)_QTY"
     objrange.Cells(7).Value="HOLD_QTY" 
     objrange.Cells(8).Value="MOVE_PASS_QTY" 
     objrange.Cells(9).Value="MOVE_FAIL_QTY" 
     objrange.Cells(10).Value="WAFE_PCS" 
     objrange.Interior.ColorIndex = 34  'Set BackColor
     objRange.Borders.LineStyle   =   1
     Set objRange = objExcel.ActiveCell.EntireColumn  
    
     objRange.AutoFit()    
     '----Fill Data---- 
   
     '----Auto Fill The Column Width---
     Set objcol = objExcel.Columns("A:J").EntireColumn
     objcol.AutoFit   
    Case "2"
     Set objRange =objExcel.Range("A1","A1") 
        objRange.EntireRow.Insert
     objRange.EntireRow.Insert 
     '---Set Title---
     Set objRange = objExcel.Range("A1","F1") 
     objRange.Font.Size = 14
     objrange.Font.Bold = True
     objrange.Font.Name  = "Times New Roman"
     objrange.Cells(1).value="O2M_AUTOWIP_FTP_TEMP"
     objrange.Interior.ColorIndex = 15  'Set BackColor
     objrange.MergeCells = true
     'objrange.HorizontalAlignment =  -4108
     objrange.HorizontalAlignment =  3
     objrange.Merge
         
     '---Set Header---
     'JOB PRODUCT PROCESS OUT_QTY DATE_CODE REMARK
   
     Set objRange = objExcel.Range("A2","F2") 
     objRange.Font.Size = 10
     objrange.Font.Bold = True
     objrange.Font.Name  = "Times New Roman"
     objrange.Cells(1).Value="JOB"
     objrange.Cells(2).Value="PRODUCT"
     objrange.Cells(3).Value="PROCESS"
     objrange.Cells(4).Value="OUT_QTY"
     objrange.Cells(5).Value="DATE_CODE"
     objrange.Cells(6).Value="REMARK"
     objrange.Interior.ColorIndex = 34  'Set BackColor
     objRange.Borders.LineStyle   =   1
     Set objRange = objExcel.ActiveCell.EntireColumn  
    
     objRange.AutoFit()    
     '----Fill Data---- 
   
     '----Auto Fill The Column Width---
     Set objcol = objExcel.Columns("A:J").EntireColumn
     objcol.AutoFit    
    Case "3"
     Set objRange =objExcel.Range("A1","A1") 
        objRange.EntireRow.Insert
     objRange.EntireRow.Insert 
     '---Set Title---
     Set objRange = objExcel.Range("A1","F1") 
     objRange.Font.Size = 14
     objrange.Font.Bold = True
     objrange.Font.Name  = "Times New Roman"
     objrange.Cells(1).value="O2MO WIP SCHEDULE CONFIRMED"
     objrange.Interior.ColorIndex = 15  'Set BackColor
     objrange.MergeCells = true
     'objrange.HorizontalAlignment =  -4108
     objrange.HorizontalAlignment =  3
     objrange.Merge
         
     '---Set Header---
     'PRODUCT JOB PROCESS JOB_QTY LOT_NUMBER DATE_CONFIRMED
     Set objRange = objExcel.Range("A2","F2") 
     objRange.Font.Size = 10
     objrange.Font.Bold = True
     objrange.Font.Name  = "Times New Roman"
     objrange.Cells(1).Value="PRODUCT"
     objrange.Cells(2).Value="JOB"
     objrange.Cells(3).Value="PROCESS"
     objrange.Cells(4).Value="JOB_QTY"
     objrange.Cells(5).Value="LOT_NUMBER"
     objrange.Cells(6).Value="DATE_CONFIRMED"   
     objrange.Interior.ColorIndex = 34  'Set BackColor
     objRange.Borders.LineStyle   =   1
     Set objRange = objExcel.ActiveCell.EntireColumn  
    
     objRange.AutoFit()
    
     '----Fill Data---- 
   
     '----Auto Fill The Column Width---
     Set objcol = objExcel.Columns("A:F").EntireColumn
     objcol.AutoFit
   Case "4"
     Set objRange =objExcel.Range("A1","A1") 
     '---Insert 6 balnk row---
        objRange.EntireRow.Insert  
     objRange.EntireRow.Insert 
     objRange.EntireRow.Insert
     objRange.EntireRow.Insert
     objRange.EntireRow.Insert
     objRange.EntireRow.Insert

     '---Insert Picedure--
     objExcel.ActiveSheet.Pictures.Insert(ws.currentdirectory&"/logo/O2.png").select
    
     Set objRange =objExcel.Range("G3","G3")
     objRange.Font.Size = 16
     objrange.Font.Bold = True
     objrange.Font.Name  = "Arial"
     objRange.Value="Shop floor move transactions"

     Set objRange =objExcel.Range("A5","B5")
     objRange.Font.Size = 9
     objrange.Font.Bold = False
     objrange.Font.Name  = "Times New Roman"
     objRange.Cells(1).Value="Organization Code:"
     objRange.Cells(2).Value="OMI"
    
     Set objRange =objExcel.Range("I5","I6")
     objRange.Font.Size = 10
     objrange.Font.Bold = True
     objrange.Font.Name  = "Times New Roman"
     objRange.Cells(1).Value="SF NO"
     objRange.Cells(2).Value="PL NO"
    
     Set objRange =objExcel.Range("J5","J6")
     objRange.Font.Size = 10
     objrange.Font.Bold = False
     objrange.Font.Name  = "Times New Roman"
     objRange.Cells(1).Value="ASXXXXXXX"
     objExcel.ActiveSheet.Range("F7","F7").Cut
     objRange.Cells(2).Select
     objExcel.ActiveSheet.Paste
    
     Set objRange=objExcel.Range("A7","A7")
     objRange.Select
     objRange.EntireRow.Delete
    
     Set objRange =objExcel.Range("A7","K7")
     objRange.Font.Size = 12
     objrange.Font.Bold = True
     objrange.Font.Name  = "Times New Roman"
     objRange.Borders.LineStyle   =   1
    
     Set objRange =objExcel.Range("A8","K8")
     objRange.Font.Size = 12
     objrange.Font.Bold = False
     objrange.Font.Name  = "Times New Roman"
     objRange.Borders.LineStyle   =   1
    
     Set objcol = objExcel.Columns("A:K").EntireColumn
     objcol.AutoFit
   End Select 
   
   
 REM Set objRange = objExcel.Range("A1","D1")
 REM objRange.Font.Size = 11
 REM objrange.Font.Bold = True
 REM objRange.Borders.LineStyle   =   1   '   1~13   have 13 line style
 
 REM Set objRange = objExcel.ActiveCell.EntireColumn
 REM objRange.AutoFit()

 objExcel.DisplayAlerts   =   False     'Close the Alert
 'objExcel.ActiveWorkBook.Saveas lstg_to_f,-4143
 'msgbox lstg_to_f
 objExcel.ActiveWorkBook.Saveas lstg_to_f,-4143
 objExcel.DisplayAlerts = False         ''Close the Save Alert
 objExcel.ActiveWorkbook.Close
 objExcel.DisplayAlerts = False
 objExcel.Application.Quit
 
End Sub

'-------Move File For Transfer Bakup Source File-----
Sub MoveFile(lstg_file,bak_folder)
   Dim fso
   dim lstg_from_file
   dim lstg_bak_folder
   dim lstg_log_folder
   dim log_msg
   lstg_from_file=bak_folder&"/"&lstg_file
   lstg_bak_folder=replace(bak_folder,"From","Bak")
   lstg_log_folder=replace(bak_folder,"From","Log")
  ' Set f = fso.GetFolder(lstg_bak_folder)
   set fso = CreateObject("Scripting.FileSystemObject")
 
   lstg_bak_folder_1=lstg_bak_folder&"/"
   If fso.FileExists(lstg_bak_folder_1&"/"&lstg_file) Then
        'msgBox lstg_file&" exists"  
  log_msg =Date&" "&Time &" Transfer File [ "& lstg_file& " ] is exists !"
  LogFile lstg_log_folder&"/"&Date&".log",log_msg
   else
  fso.MoveFile lstg_from_file,lstg_bak_folder_1
  log_msg=Date&" "&Time &" Move File [ "& lstg_file& " ] is Success !"
  LogFile lstg_log_folder&"/"&Date&".log",log_msg
   end if    
End Sub

'-------File Operation Log-----
Sub LogFile(lstg_file,log_msg)
 Dim fso,f, LogFile
    Set fso = CreateObject("Scripting.FileSystemObject")
 
 If fso.FileExists(lstg_file) Then
   Set f = fso.GetFile(lstg_file)
    Set LogFile = f.OpenAsTextStream(ForAppending, TristateUseDefault)
    LogFile.WriteLine log_msg
    LogFile.Close
    else
  Set LogFile = fso.CreateTextFile(lstg_file, True)
  LogFile.WriteLine log_msg
  LogFile.Close
    end if    
End Sub

 

---Result---