Solved

VBscript Array to store names of files in each loop

Posted on 2014-03-14
4
664 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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Over the years I have built up my own little library of code snippets that I refer to when programming or writing a script.  Many of these have come from the web or adaptations from snippets I find on the Web.  Periodically I add to them when I come…
This article is the result of a quest to better understand Task Scheduler 2.0 and all the newer objects available in vbscript in this version over  the limited options we had scripting in Task Scheduler 1.0.  As I started my journey of knowledge I f…
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…
As a trusted technology advisor to your customers you are likely getting the daily question of, ‘should I put this in the cloud?’ As customer demands for cloud services increases, companies will see a shift from traditional buying patterns to new…

895 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

Need Help in Real-Time?

Connect with top rated Experts

14 Experts available now in Live!

Get 1:1 Help Now