🚀 go-pugleaf

Dnia Sat, 15 Aug 2015 03:59:00 -0700 (PDT), Jan Koc napisał(a):

> Witam 
> Niestety po migracji do Windowsa 10 znowu zacząłem mieć problem z plikiem Excela. 
> W poprzednich korespondencjach opisałem problem, więc w skrócie. Dostaję z zewnętrznej firmy plik z rozszerzeniem NazwaPliku.xls Chciałem z niego metodą 
> TransferSpreadsheet acImport pobrać trochę danych ale nie było to możliwe. Po kilku radach i próbach udało się wybrnąć z sytuacji tak, że plik był z poziomu VB zamieniany na plik z rozszerzeniem NazwaPliku.xlsx 
> 
>   Dim A As String 
>   Dim AB As String 
>        A = "C:\Baz\" & NazwaPliku & "" 
>        AB = "C:\Baz\" & NazwaPliku & "x" 
>         fSaveAsXlsx A, AB 
> 
> Public Sub fSaveAsXlsx(sSrcFilePath As String, sDstFilePath As String) 
> Dim oExcel As Object 
> Dim oWorkbook  As Object 
> Const xlOpenXMLWorkbook = 51 
> 
>     Set oExcel = CreateObject("Excel.Application") 
>        oExcel.Visible = False 
>        Set oWorkbook = oExcel.Workbooks.Open(sSrcFilePath) 
>         
>            oWorkbook.SaveAs sDstFilePath 
>           
>            oWorkbook.Close 
>            oExcel.Quit 
>           
>        Set oWorkbook = Nothing 
>     Set oExcel = Nothing 
> End Sub 
> 
> i wtedy udawało się odczytacz i zaimportować do tabeli Accessowej. 
> 
> DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, _ 
> "import3", "C:\Baz", True, "A10:AE500" 
> 
> To była proteza ale działała. 
> Niestety przestała. 
> Oczywiście jeśli otworzę plik .xls i potem zapiszę go jako .xlsx to metoda działa poprawnie 
> Może zacząć od początku i ktoś przyjrzy się temu plikowi .xls bo chyba w tym tkwi problem. 
> Jeśli ktoś będzie zainteresowany to wyślę przykładowy plik NazwaPliku.xls 
> mój adres (bez  x-ów) to: xkociumbasx@wp.pl 
> 
> Dziękuję Jan

Nie wiem jak wielki jest ten zakres danych z excela i czy zależy Tobie
na prędkości ale skoro i tak tworzysz obiekty excela, to może po prosty
odczytuj w pętli wartości poszczególnych komórek i zapisuj do wcześniej
zdefiniowanej tabeli 

coś na ten sposób


'do powyższych deklaracji
dim oSheet as object 
dim conn As ADODB.Connection
Dim tabela As New ADODB.Recordset

Set conn = CurrentProject.Connection
tabela.Open "NazwaTwojejTabeli", conn, adOpenDynamic, adLockOptimistic

set oSheet = oWorkbook.worksheet(1)

for i=pierwszyWiersz to ostatni wiersz
	with tabela
		.AddNew
		with oSheet
			!pole1=.Cells(i, 1).value
			!pole2=.Cells(i, 2).value
			...
			!poleN=.Cells(i, N).value
			
		end with
		.update
	end with
next i


-- 
Pozdrawiam AdamS

Przepisałem całość:
xxxx = "C:\Baza_Jan\biznes polska\" & Nazwa.xls
Dim oExcel As Object
Dim oWorkbook  As Object
Const xlOpenXMLWorkbook = 51

    Set oExcel = CreateObject("Excel.Application")
       oExcel.Visible = False
       Set oWorkbook = oExcel.Workbooks.Open(xxxx)
       

Dim oSheet As Object
Dim conn As ADODB.Connection
Dim tabela As New ADODB.Recordset
Set conn = CurrentProject.Connection
tabela.Open "PlikiExcela2", conn, adOpenDynamic, adLockOptimistic


Set oSheet = oWorkbook.worksheet(1)  

I TU PROGRAM SIĘ WYSYPUJE> NIE WIM CZEMU (nazwa excelowskiego zeszytu to 1)
TWIERDZI ŻE METODA JEST NIEZNANA


For P = 10 To 50
        With tabela
                .AddNew
                With oSheet
                    For R = 1 To 31
                        !pole(R) = .Cells(P, R).Value
                  Next R
                         
                End With
                .Update
        End With
Next P
    oWorkbook.Close
           oExcel.Quit
          
       Set oWorkbook = Nothing
    Set oExcel = Nothing

Proszę zmienić nazwę z 1 na inną
albo też 1 wziąć w cudzysłowy "1"
Excel rozumie cyfrę po słowie worksheet jako pierwszy arkusz

MF

Poprawiłem to i jeszcze chyba były błędy w odwołaniu do komórek Excela. Ale już biega.
Dziękuję .

Teraz mam jeszcze problem z plikiem nazwa.xls który nie jest plikiem Excelowym i muszę go zamieniać ręcznie tzn
Przed przesiadką na Windowsa 10 to biegało tak (rozwiązanie, które dostałem od Zbigniewa Bratko):

        Dim A As String
        Dim AB As String
       A = "C:\Baza_Jan\biznes polska\" & NazwaPlik & ""
       AB = "C:\Baza_Jan\biznes polska\" & NazwaPlik & "x"
       fSaveAsXlsx A, AB



Public Sub fSaveAsXlsx(sSrcFilePath As String, sDstFilePath As String)
Dim oExcel As Object
Dim oWorkbook  As Object
Const xlOpenXMLWorkbook = 51 

    Set oExcel = CreateObject("Excel.Application")
       oExcel.Visible = False
       Set oWorkbook = oExcel.Workbooks.Open(sSrcFilePath)
       
           oWorkbook.SaveAs sDstFilePath 
         
           oWorkbook.Close
           oExcel.Quit
          
       Set oWorkbook = Nothing
    Set oExcel = Nothing
End Sub
 a teraz robię to na piechotę :

1. Otwieram (otwiera się z blokadą na edycję) odblokowuję możliwość edycji
2. Wchodzę na menu Plik i klikam Konwertuj.
3. W oknie Excela pojawiaja się informacja że plik zostanie zmieniony "OK"
4. Druga informacja, że plik udało się konwertować do aktualnej wersji Excela "OK"

I dopiero teraz po zamknięciu pliku mogę bawić się przerzucaniem danych do Accessa wg programu jak wyżej

Czy ktoś mógłby mi podpowiedzieć jak to z pod VB zautomatyzować.

Jan

trochę kodu znalzałem gdzieś VBScript:

Dim xlApp, workBook1, workBook2,aSheets, fileName, aInfo2,aInfo1,oExcel
  Const XlPlatform = "xlWindows"
  Const xlDelimited = 1
  Const xlTextQualifierDoubleQuote = 1
  Const xlTextFormat = 2
  Const xlGeneralFormat = 1


  Set oExcel = Sys.OleObject("Excel.Application")  
  Set xlApp = CreateObject("Excel.Application")  

  Set workBook1 = xlApp.ActiveWorkBook

  Set workBook1 = xlApp.WorkBooks.OpenText("Y:\Personal Folders\XXXX\TestFile1.csv",XlPlatform, 1, xlDelimited, xlTextQualifierDoubleQuote, true, false, false, true, false, true, "CRLF", Array(Array (1,2),Array (2,2),Array (3,2),Array (4,1),Array (5,2),Array (6,1),Array (7,1),Array (8,1),Array (9,1),Array (10,1),Array (11,1)), true, false)

  Set workBook1 = xlApp.ActiveWorkBook
  xlApp.Visible = true

  workBook1.Save "Y:\Personal Folders\XXXX\x.xlsx", xlNormal
  workBook1.Close

Może coś dopomoże?

Pozdrawiam

cytowane za stackoveflow
Komuś innemu pomogło poniższe:

"

Const xlDelimited                =  1
Const xlTextQualifierDoubleQuote =  1
Const xlOpenXMLWorkbook          = 51

Set xl = CreateObject("Excel.Application")

xl.Workbooks.OpenText "Y:\Personal Folders\XXXX\TestFile1.csv", , , xlDelimited _
  , xlTextQualifierDoubleQuote, True, False, False, True, False, False, _
  , Array(Array(1,2), Array(2,2), Array(3,2), Array(4,1), Array(5,2) _
  , Array(6,1), Array(7,1), Array(8,1), Array(9,1), Array(10,1), Array(11,1))
Set wb = xl.ActiveWorkbook

wb.SaveAs "Y:\Personal Folders\XXXX\x.xlsx", xlOpenXMLWorkbook, , , , False
wb.Close

xl.Quit

"

Pozdrawiam
/
MF

Panie Macieju !!!
Dziękuję za pomoc.
Pierwszego ne sprawdzałem, ale drugi kod zrobił to co trzeba.
Jeszcze raz dziękuję

Jan