Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

VBscript Array to store names of files in each loop

Posted on 2014-03-14
4
Medium Priority
?
686 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

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

This is pretty cool.  The purpose of this VB Script is to help you document where JAR (Java ARchive) files and specifically java class files are located so that you can address issues seen with a client or that you can speak intelligently with a dev…
Deploying a Microsoft Access application in a Citrix environment is not difficult but takes a few steps. However, Citrix system people are often of little help, as they typically know next to nothing about Access. The script provided here will take …
Do you want to know how to make a graph with Microsoft Access? First, create a query with the data for the chart. Then make a blank form and add a chart control. This video also shows how to change what data is displayed on the graph as well as form…
Sometimes it takes a new vantage point, apart from our everyday security practices, to truly see our Active Directory (AD) vulnerabilities. We get used to implementing the same techniques and checking the same areas for a breach. This pattern can re…
Suggested Courses

660 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