VBscript Array to store names of files in each loop

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

adirisinAsked:
Who is Participating?
 
sirbountyConnect With a Mentor Commented:
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
 
adirisinAuthor Commented:
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
 
adirisinAuthor Commented:
Hi Sirbounty,

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

Thanks so much!!

Regards,
Adirisin
0
 
sirbountyCommented:
Happy to help - thanx for the grade! :^)
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.