Новая версия сайта, доступна здесь.




Чтение excel


Пограмма чтения файла xls (таблицы excel).
Пограмма чтения указанной таблицы из файла xls (таблицы excel).

;;	eea-get_xl.lsp

(defun eea-get_xl (tbl / ADOCONNECT ADORECORDSET LST)
		  ;|
*****************************************************************************************

by ElpanovEvgeniy

Библиотечная функция, 

Пограмма чтения файла xls (таблицы excel) из лиспа.
Не требует установленного Microsoft Office Excel
Протестированно с Microsoft Office Excel 2003

Аргумент
tbl - строка, содержащая название таблицы и путь к ней.

Дата создания       - 11.05.2006
Последняя редакция  - 19.02.2007
*****************************************************************************************

Library function.

Data reading from Microsoft Excel not using Excel.
This code, can read diverse data from all tables.

 ARGUMENTS:
 A string containing a complete file name, including the path.
 (setq tbl "D:\\4.xls")

Date of creation  - 11.05.2006
Last edition      - 19.02.2007
*****************************************************************************************

 USAGE:
 (eea-get_xl tbl)

 RETURN VFALUES
 The list of all pages in a file with all data

*****************************************************************************************
|;
  (defun rec-rem-dupl (lst)
    (if	lst
      (cons (car lst) (rec-rem-dupl (vl-remove (car lst) (cdr lst))))
    ) ;_  if
  ) ;_  defun
  (setq	ADOConnect   (vlax-get-or-create-object "ADODB.Connection")
	ADORecordset (vlax-get-or-create-object "ADODB.Recordset")
  ) ;_  setq
  (if (not (vl-catch-all-error-p
	     (vl-catch-all-apply
	       (function vlax-invoke-method)
	       (list ADOConnect
		     "Open"
		     (strcat "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
			     tbl
			     ";Extended Properties=;Excel 8.0;HDR=No"
		     ) ;_  strcat
		     "admin"
		     ""
		     nil
	       ) ;_  list
	     ) ;_  vl-catch-all-apply
	   ) ;_  vl-catch-all-error-p
      ) ;_  not
    (progn (setq
	     lst (mapcar
		   (function (lambda (l / i c)
			       (vlax-invoke-method ADORecordset
						   "Open"
						   (strcat "SELECT * FROM [" l "]")
						   ADOConnect
						   1
						   3
						   nil
			       ) ;_  vlax-invoke-method
			       (setq
				 i (length
				     (car (vlax-safearray->list
					    (vlax-variant-value
					      (vlax-invoke-method ADORecordset
								  "GetRows"
								  65535
					      ) ;_  vlax-invoke-method
					    ) ;_  vlax-variant-value
					  ) ;_  vlax-safearray->list
				     ) ;_  car
				   ) ;_  length
			       ) ;_  setq
			       (vlax-invoke-method ADORecordset "Close")
			       (while (not (zerop i))
				 (vlax-invoke-method ADORecordset
						     "Open"
						     (strcat "SELECT * FROM ["
							     l
							     "a"
							     (itoa i)
							     ":IV"
							     (itoa i)
							     "]"
						     ) ;_  strcat
						     ADOConnect
						     1
						     3
						     nil
				 ) ;_  vlax-invoke-method
				 (setq c (cons
					   (car
					     (apply
					       (function mapcar)
					       (cons 'list
						     (mapcar
						       (function
							 (lambda (a)
							   (mapcar
							     (function
							       (lambda (b)
								 (vlax-variant-value b)
								)
							     ) ;_  function
							     a
							   ) ;_  mapcar
							 ) ;_  lambda
						       ) ;_  function
						       (vlax-safearray->list
							 (vlax-variant-value
							   (vlax-invoke-method
							     ADORecordset
							     "GetRows"
							     65535
							   ) ;_  vlax-invoke-method
							 ) ;_  vlax-variant-value
						       ) ;_  vlax-safearray->list
						     ) ;_  mapcar
					       ) ;_  cons
					     ) ;_  apply
					   ) ;_  car
					   c
					 ) ;_  cons
				       i (1- i)
				 ) ;_  setq
				 (vlax-invoke-method ADORecordset "Close")
			       ) ;_  while
			       (if (equal c '((nil) (nil)))
				 (list l)
				 (cons l c)
			       ) ;_  if
			     ) ;_  lambda
		   ) ;_  function
		   (mapcar
		     (function (lambda (x)
				 (if (= (substr x 1 1) "'")
				   (substr x 2 (- (strlen x) 2))
				   x
				 ) ;_  if
			       ) ;_  lambda
		     ) ;_  function
		     (rec-rem-dupl
		       (caddr
			 (mapcar
			   (function
			     (lambda (a) (mapcar (function vlax-variant-value) a))
			   ) ;_  function
			   (vlax-safearray->list
			     (vlax-variant-value
			       (vlax-invoke-method
				 (vlax-invoke-method ADOConnect "OpenSchema" 4)
				 "GetRows"
				 65535
			       ) ;_  vlax-invoke-method
			     ) ;_  vlax-variant-value
			   ) ;_  vlax-safearray->list
			 ) ;_  apply
		       ) ;_  caddr
		     ) ;_  rec-rem-dupl
		   ) ;_  mapcar
		 ) ;_  mapcar
	   ) ;_  setq
	   (vlax-invoke-method ADOConnect "Close")
	   (vlax-release-object ADORecordset)
	   (vlax-release-object ADOConnect)
	   (setq ADORecordset nil
		 ADOConnect nil
	   ) ;_  setq
	   lst
    ) ;_  progn
    (progn (vl-catch-all-apply 'vlax-invoke-method (list ADOConnect "Close"))
	   (vlax-release-object ADORecordset)
	   (vlax-release-object ADOConnect)
	   (setq ADORecordset nil
		 ADOConnect nil
	   ) ;_  setq
	   nil
    ) ;_  progn
  ) ;_  if
) ;_  defun

Наверх




(defun eea-get_xl_sheet	(tbl sheet / ADOCONNECT ADORECORDSET C I i1)
			;|
*****************************************************************************************

by ElpanovEvgeniy

Библиотечная функция, 

Пограмма чтения указанной таблицы из файла xls.
Не требует установленного Microsoft Office Excel
Протестированно с Microsoft Office Excel 2003

Аргумент
tbl - строка, содержащая название таблицы и путь к ней.
sheet - строка, имя таблицы в файле, которую необходимо прочесть.

Дата создания       - 11.05.2006
Последняя редакция  - 19.02.2007
*****************************************************************************************

Library function.

Data reading from Microsoft Excel not using Excel.
This code, can read data from one table.

 ARGUMENTS:
 A string containing a complete file name, including the path.
 (setq tbl "D:\\4.xls" "list-1")

Date of creation  - 11.05.2006
Last edition      - 19.02.2007
*****************************************************************************************

 USAGE:
 (eea-get_xl_sheet tbl sheet)

 RETURN VFALUES
 The list of all pages in a file with all data

*****************************************************************************************
|;
  (setq	ADOConnect   (vlax-get-or-create-object "ADODB.Connection")
	ADORecordset (vlax-get-or-create-object "ADODB.Recordset")
  ) ;_  setq
  (if (not (vl-catch-all-error-p
	     (vl-catch-all-apply
	       (function vlax-invoke-method)
	       (list ADOConnect
		     "Open"
		     (strcat "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
			     tbl
			     ";Extended Properties=;Excel 8.0;HDR=No"
		     ) ;_  strcat
		     "admin"
		     ""
		     nil
	       ) ;_  list
	     ) ;_  vl-catch-all-apply
	   ) ;_  vl-catch-all-error-p
      ) ;_  not
    (progn
      (if
	(member
	  (strcat sheet "$")
	  (mapcar
	    (function (lambda (x)
			(if (= (substr x 1 1) "'")
			  (substr x 2 (- (strlen x) 2))
			  x
			) ;_  if
		      ) ;_  lambda
	    ) ;_  function
	    (caddr
	      (mapcar
		(function (lambda (a) (mapcar (function vlax-variant-value) a)))
		(vlax-safearray->list
		  (vlax-variant-value
		    (vlax-invoke-method
		      (vlax-invoke-method ADOConnect "OpenSchema" 4)
		      "GetRows"
		      65535
		    ) ;_  vlax-invoke-method
		  ) ;_  vlax-variant-value
		) ;_  vlax-safearray->list
	      ) ;_  apply
	    ) ;_ caddr
	  ) ;_  mapcar
	) ;_ member
	 (progn
	   (vlax-invoke-method ADORecordset
			       "Open"
			       (strcat "SELECT * FROM [" sheet "$]")
			       ADOConnect
			       1
			       3
			       nil
	   ) ;_  vlax-invoke-method
	   (if (> (progn (setq i
				(length
				  (car (vlax-safearray->list
					 (vlax-variant-value
					   (vlax-invoke-method ADORecordset "GetRows" 65536)
					 ) ;_  vlax-variant-value
				       ) ;_  vlax-safearray->list
				  ) ;_  car
				) ;_ length
			 ) ;_  setq
			 (vlax-invoke-method ADORecordset "Close")
			 i
		  ) ;_ progn
		  0
	       ) ;_ >
	     (progn
	       (setq i1 1)
	       (while (vl-catch-all-error-p
			(vl-catch-all-apply (function vlax-invoke-method)
					    (list ADORecordset
						  "Open"
						  (strcat "SELECT * FROM ["
							  sheet
							  "$a"
							  (itoa i1)
							  ":IV"
							  (itoa i1)
							  "]"
						  ) ;_  strcat
						  ADOConnect
						  1
						  3
						  nil
					    ) ;_ list
			) ;_ vl-catch-all-apply
		      ) ;_ vl-catch-all-error-p
		 (setq i1 (1+ i1))
	       ) ;_ while
	       (vlax-invoke-method ADORecordset "Close")
	       (setq i (+ i i1))
	       (while (>= i i1)
		 (if (not (vl-catch-all-error-p
			    (vl-catch-all-apply	(function vlax-invoke-method)
						(list ADORecordset
						      "Open"
						      (strcat "SELECT * FROM ["
							      sheet
							      "$a"
							      (itoa i)
							      ":IV"
							      (itoa i)
							      "]"
						      ) ;_  strcat
						      ADOConnect
						      1
						      3
						      nil
						) ;_ list
			    ) ;_ vl-catch-all-apply
			  ) ;_ vl-catch-all-error-p
		     ) ;_ not
		   (progn (setq	c (cons
				    (car
				      (apply
					(function mapcar)
					(cons 'list
					      (mapcar
						(function
						  (lambda (a)
						    (mapcar
						      (function
							(lambda	(b)
							  (vlax-variant-value b)
							) ;_  lambda
						      ) ;_  function
						      a
						    ) ;_  mapcar
						  ) ;_  lambda
						) ;_  function
						(vlax-safearray->list
						  (vlax-variant-value
						    (vlax-invoke-method
						      ADORecordset
						      "GetRows"
						      65535
						    ) ;_  vlax-invoke-method
						  ) ;_  vlax-variant-value
						) ;_  vlax-safearray->list
					      ) ;_  mapcar
					) ;_  cons
				      ) ;_  apply
				    ) ;_  car
				    c
				  ) ;_  cons
				i (1- i)
			  ) ;_  setq
			  (vlax-invoke-method ADORecordset "Close")
		   ) ;_ progn
		   (setq i (1- i))
		 ) ;_ if
	       ) ;_  while
	     ) ;_ progn
	   ) ;_ if
	 ) ;_ progn
      ) ;_ if
      (vlax-invoke-method ADOConnect "Close")
      (vlax-release-object ADORecordset)
      (vlax-release-object ADOConnect)
      (setq ADORecordset nil
	    ADOConnect nil
      ) ;_  setq
      c
    ) ;_  progn
    (progn (vl-catch-all-apply 'vlax-invoke-method (list ADOConnect "Close"))
	   (vlax-release-object ADORecordset)
	   (vlax-release-object ADOConnect)
	   (setq ADORecordset nil
		 ADOConnect nil
	   ) ;_  setq
	   nil
    ) ;_  progn
  ) ;_  if
) ;_  defun

Наверх