[ create a new paste ] login | about

Link: http://codepad.org/2O4Mh3PV    [ raw code | fork ]

Plain Text, pasted on Nov 4:
Option Explicit

Const EXCEL_FILE_FOLDER = "E:\ExcelTest"

Dim xlsnew
Set xlsnew = CreateObject("Excel.Application")
xlsnew.workbooks.add

xlsnew.visible = true

Dim sheetnew
set sheetnew = xlsnew.Activeworkbook.activesheet

dim newrow, newcol
newrow = 1
newcol = 1

Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")

Dim file
For Each file In fso.GetFolder(EXCEL_FILE_FOLDER).Files
	Call readexcel(file, sheetnew, newrow, newcol)
Next

xlsnew.Quit


Sub readexcel(filename, sheetnew, newrow, newcol)

	Dim xls
	Set xls = CreateObject("Excel.Application")

	xls.Visible = True

	xls.Workbooks.Open filename
	Dim sheet
	set sheet = xls.Activeworkbook.activesheet

	dim row, col
	row = 1
	do while true
		col = 1
		newcol = 1
		if sheet.cells(row, col).value = "" then exit do
		do while true
			if sheet.cells(row, col).value = "" then exit do
			sheetnew.cells(newrow, col).value = sheet.cells(row, col).value
			col = col + 1
			newcol = newcol + 1
		loop
		row = row + 1
		newrow = newrow + 1
	loop

	xls.Quit

	Set xls = Nothing

End Sub



Create a new paste based on this one


Comments: