Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

VBscript Array to store names of files in each loop

Posted on 2014-03-14
4
Medium Priority
?
693 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 2000 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: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

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

Welcome back!  My apologies for taking so long to write part two of this series; it's been a long time coming!  As I promised in Part 1, this article will focus on how to locate those elusive AD properties that you are searching for.  Why is this us…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
As many of you are aware about Scanpst.exe utility which is owned by Microsoft itself to repair inaccessible or damaged PST files, but the question is do you really think Scanpst.exe is capable to repair all sorts of PST related corruption issues?
The Relationships Diagram is a good way to get an overall view of what a database is keeping track of. It is also where relationships are defined. A relationship specifies how two tables connect to each other. As you build tables in Microsoft Ac…
Suggested Courses
Course of the Month12 days, 11 hours left to enroll

580 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