Solved

VBscript Array to store names of files in each loop

Posted on 2014-03-14
4
671 Views
Last Modified: 2014-03-14
Hi,

I need to write a vbscript which matches input files headers (columns A,B, C) with those of an template and only then appends data from these files into one single file.
In case the layout of input file is different from that of template, it moves them to an ErrorFolder.  (Please refer to the comment 'Errorfiles' in the code)

I want to create a dynamic array which would store the names of these incorrect layout (error) files so i can retrieve this list and mail it via VBscript. Please advise.

Code is below:

Thanks,
Adirisin


Const DestinationFolder = "C:\Users\aditya.kumar.vaish\Downloads\test\test_1\test_new\abc\"
Const ErrorFolder = "C:\Users\aditya.kumar.vaish\Downloads\Trial_Runs\Error_File\"
Const xlToRight = -4161
Const xlDown = -4121
Const xlup = -4162

Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("C:\Users\aditya.kumar.vaish\Downloads\Test\test_3\Template.xls")
objExcel.Application.DisplayAlerts = False
objExcel.Application.Visible = true

objWorkbook.Sheets(1).Range("A2:IV65536").Cells.ClearContents

Set fso = CreateObject("Scripting.FileSystemObject")
For Each f In fso.GetFolder(DestinationFolder).Files
  If LCase(fso.GetExtensionName(f)) = "xls" Then
    Set wb = objExcel.Workbooks.Open(f.Path)
Set ws = wb.Sheets(1)
    ws.Activate
A = "Inquiry_ID"
B = "List_ID"
C = "Budget_Owner"
Do
    test1 = false
    If Not ws.Range("A1").value = A Then Exit Do
    If Not ws.Range("B1").value = B Then Exit Do
    If Not ws.Range("C1").value = C Then Exit Do
    test1 = True
    Loop Until True

If test1 Then 
ws.Activate
Set firstCell = ws.Range("A1")
Set lastcell = ws.Range(firstcell,firstcell.End(xlToRight))
Set downcell = ws.Range(firstcell,firstCell.End(xlDown))
Set startcell = ws.Range("A2")
Set finalCell = ws.Range(lastcell,downcell)
myformatarea1 = ws.Range(lastcell,downcell).Copy

Set pasterange = objWorkbook.Sheets(1).Range("a65536").End(xlUp).Offset(1,0)

pasterange.PasteSpecial Paste =xlValues
'objWorkbook.Save 
wb.Close True
Else
'Errorfiles
errorname = fso.BuildPath(ErrorFolder, fso.GetBaseName(wb.Name) & ".xlsx")
wb.SaveAs errorname, 51
wb.Close True
End If
End If
Next


x=2
Do while objWorkbook.Sheets(1).Cells(x,1).Value <> ""
If objWorkbook.Sheets(1).Cells(x,1).Value = "Inquiry_ID" then
objWorkbook.Sheets(1).Cells(x,1).Entirerow.delete 

End If
x=x+1
Loop
objWorkbook.Sheets(1).Activate
objWorkbook.Sheets(1).Range("a1").activate
objWorkbook.Save 

ObjExcel.Quit
Set app = Nothing
Set fso = Nothing 

Open in new window

0
Comment
Question by:adirisin
  • 2
  • 2
4 Comments
 
LVL 67

Accepted Solution

by:
sirbounty earned 500 total points
ID: 39928959
This is one way, and there are many...is to create a dictionary object:
Dim dicErrors : Set dicErrors = CreateObject("Scripting.Dictionary") 'place at the beginning of the script


Then in your 'Errorfiles section, adjust it as such:

'Errorfiles
errorname = fso.BuildPath(ErrorFolder, fso.GetBaseName(wb.Name) & ".xlsx")
dicErrors .Add dicErrors .count, errorname 'Added this line
wb.SaveAs errorname, 51
wb.Close True
End If


Finally, when you are ready to send the mail notice:

for x = 0 to dicErrors .count - 1
  mailMessage = mailMessage & vbNewLine & dicErrors .Item(x)
next

Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Error files"
objMessage.From = "youremail@company.com"
objMessage.To = "recipient@company.com"
objMessage.TextBody = mailMessage
objMessage.Send
0
 

Author Comment

by:adirisin
ID: 39929023
Hi Sirbounty,

I made the changes as suggested, however, i am only getting the name of the last error file processed through the loop. This is the mail message that i get:

C:\Users\aditya.kumar.vaish\Downloads\Trial_Runs\Error_File\Book4.xlsx

I have one more workbook Book3.xlsx which has improper layout, can information of this file be added as well to the mail body.

thanks again.
0
 

Author Closing Comment

by:adirisin
ID: 39929046
Hi Sirbounty,

Your code is perfect! I did a goof-up on my end.

Thanks so much!!

Regards,
Adirisin
0
 
LVL 67

Expert Comment

by:sirbounty
ID: 39929080
Happy to help - thanx for the grade! :^)
0

Featured Post

Free Tool: Postgres Monitoring System

A PHP and Perl based system to collect and display usage statistics from PostgreSQL databases.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Recently I finished a vbscript that I thought I'd share.  It uses a text file with a list of server names to loop through and get various status reports, then writes them all into an Excel file.  Originally it was put together for our Altiris server…
Not long ago I saw a question in the VB Script forum that I thought would not take much time. You can read that question (Question ID  (http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28455246.html)28455246) Here (http…
Nobody understands Phishing better than an anti-spam company. That’s why we are providing Phishing Awareness Training to our customers. According to a report by Verizon, only 3% of targeted users report malicious emails to management. With compan…
I've attached the XLSM Excel spreadsheet I used in the video and also text files containing the macros used below. https://filedb.experts-exchange.com/incoming/2017/03_w12/1151775/Permutations.txt https://filedb.experts-exchange.com/incoming/201…

679 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question