[Tajan]

W wątku: http://www.excelforum.pl/viewtopic.php?t=12349 pojawił sie problem użycia powszechnie stosowanej funkcji GetValue, służącej do pobierania danych z zamkniętych skoroszytów, jako funkcji arkusza. Niestety, ze względu na zastosowanie w niej makr typu XLM, funkcja tak zastosowana nie działa.
Pomyślałem, że można by było spróbować wykorzystac do tego celu ADO. Na razie wyszło mi takie coś:

Kod:

Function ADOGetValue(path As String, file As String, sheet As String, ref As String) ' =ADOGetValue(p;f;s;r) ' p - scieżka ' f - nazwa pliku ' s - nazwa arkusza ' r - komórka lub obszar np. "A3", "A1:A10"     Dim arg As String     Dim nRowCount As Long, nColCount As Long     Dim nActRow As Long, nActCol As Long     Dim ArrVal() As Variant     Dim xArray As Variant     Dim xValue As Variant         Dim oCn As Object, oRs As Object         If Right(path, 1) <> "\" Then path = path & "\"         If Dir(path & file) = "" Then         'brak pliku ...         ADOGetValue = CVErr(2042)         Exit Function     End If         Set oCn = CreateObject("ADODB.Connection")         oCn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _            "Data Source=" & path & file & ";" & _            "Extended Properties=""Excel 8.0;HDR=NO;IMEX=1;"""         arg = "select * from [" & sheet & "$" & ref & _           IIf(InStr(ref, ":") = 0, ":" & ref, "") & "]"               Set oRs = CreateObject("ADODB.Recordset")         oRs.Open arg, oCn, 3         xArray = oRs.getRows             nRowCount = UBound(xArray, 2)     nColCount = UBound(xArray, 1)         ReDim ArrVal(1 To nRowCount + 1, 1 To nColCount + 1)         For nActRow = 0 To nRowCount                 For nActCol = 0 To nColCount                         xValue = xArray(nActCol, nActRow)                         If IsNumeric(xValue) Then                xValue = CDbl(xValue)             ElseIf IsNull(xValue) Then                xValue = Empty             End If                         ArrVal(nActRow + 1, nActCol + 1) = xValue                 Next         Next     ADOGetValue = ArrVal         oRs.Close     oCn.Close         Set oRs = Nothing     Set oCn = Nothing     End Function

Wprawdzie nie testowałem jej zbyt intensywnie, ale chyba działa! Wszystkie parametry - tekstowe. Może być użyteczna, gdy zachodzi potrzeba skorzystania np. z funkcji ADR.POŚR, ale skoroszyt źródłowy jest zamknięty, więc trzeba uciekać się do innych sposobów.
Zapraszam do testowania. Pewne wady już zauważyłem i spróbuję je naprawić w późniejszym terminie. Na razie czekam na wasze opinie.

[tkuchta1]

Tajan Wielki SZACUN i podziękowania za tą funkcję. W paru formułach już wykorzystywałem i wszystkie Importy danych XL2XL bez otwierania pliku źródłowego opierałem o trzewia tej funkcji

Co zauważyłem - i proponuję poprawić to treść ConnectionString'a wg Wersji Excela.

Kod:

Dim strConnectionString As String     '...         If Val(Application.Version) < 12 Then         strConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _                               "Data Source=" & path & file & ";" & _                               "Extended Properties=""Excel 8.0;HDR=NO;IMEX=1;"""     Else         strConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _                               "Data Source=" & path & file & ";" & _                               "Extended Properties=""Excel 12.0;HDR=NO;IMEX=1;"""     End If     oCn.Open strConnectionString

po tej zmianie podanie w arg.file "zeszyt.xlsm" czy "Zeszyt.xlsx" nie zwróci błędu.

Hej.

[Tajan]

tkuchta1, jest super

[Marecki]

W związku z tym, iż nie wszystkie osoby potrafią wprowadzić sugestię Tomka, dlatego też poniżej zamieszczam funkcję Tajana z uwzględnioną "poprawką":

Kod:

Function ADOGetValue(path As String, file As String, sheet As String, ref As String) ' =ADOGetValue(p;f;s;r) ' p - scieżka ' f - nazwa pliku ' s - nazwa arkusza ' r - komórka lub obszar np. "A3", "A1:A10"     Dim arg As String     Dim nRowCount As Long, nColCount As Long     Dim nActRow As Long, nActCol As Long     Dim ArrVal() As Variant     Dim xArray As Variant     Dim xValue As Variant     Dim strConnectionString As String     Dim oCn As Object, oRs As Object     If Right(path, 1) <> "\" Then path = path & "\"     If Dir(path & file) = "" Then         'brak pliku ...         ADOGetValue = CVErr(2042)         Exit Function     End If     Set oCn = CreateObject("ADODB.Connection")     If Val(Application.Version) < 12 Then         strConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _                               "Data Source=" & path & file & ";" & _                               "Extended Properties=""Excel 8.0;HDR=NO;IMEX=1;"""     Else         strConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _                               "Data Source=" & path & file & ";" & _                               "Extended Properties=""Excel 12.0;HDR=NO;IMEX=1;"""     End If     oCn.Open strConnectionString     arg = "select * from [" & sheet & "$" & ref & _           IIf(InStr(ref, ":") = 0, ":" & ref, "") & "]"     Set oRs = CreateObject("ADODB.Recordset")     oRs.Open arg, oCn, 3     xArray = oRs.getRows     nRowCount = UBound(xArray, 2)     nColCount = UBound(xArray, 1)     ReDim ArrVal(1 To nRowCount + 1, 1 To nColCount + 1)     For nActRow = 0 To nRowCount         For nActCol = 0 To nColCount             xValue = xArray(nActCol, nActRow)             If IsNumeric(xValue) Then                 xValue = CDbl(xValue)             ElseIf IsNull(xValue) Then                 xValue = Empty             End If             ArrVal(nActRow + 1, nActCol + 1) = xValue         Next     Next     ADOGetValue = ArrVal     oRs.Close     oCn.Close     Set oRs = Nothing     Set oCn = Nothing End Function

P/S
Temat zamykam.
W przypadku gdy ktoś niższy rangą chciałby wnieść coś nowego do tematu , funkcji, proszony jest o kontakt z Administratorem lub Moderatorem forum.

[Artik]

Jest problem.

Kiedy nazwa arkusza zaczyna się od spacji otrzymuję błąd o nieprawidłowych nawiasach

Jak to obejść, bo nie mam wpływu na nazwę arkusza?

Artik

[Marecki]

Artik nie mam jak sprawdzić, ale może pomoże dodanie apostrofów -coś jak w tym temacie http://www.excelforum.pl/...rof%2A+spacj%2A

[Artik]

Już próbowałem, ale być może w złych miejscach wstawiałem.

Artik

[hudibyk]

Wczoraj trafiłem na jakąś stronę (myślę, że pomogłoby) ale za cholerę nie mogę jej znaleźć. Coś mi się kojarzy, że musisz kombinować z nazwą pliku w nawiasach kwadratowych

[Artik]

Przeprowadziłem dalsze badania raczej metodą prób i błędów.

1. Jeżeli arkusz ma nazwę "Ala ma kota" (czyli akceptowalna przez ADO), a w powyższym kodzie dołożę apostrofy:

Cytat:

arg = "SELECT * FROM ['" & sheet & "$'" & ref & _ IIf(InStr(ref, ":") = 0, ":" & ref, "") & "]"

to otrzymuję błąd:

Cytat:

Error -2147217865: Aparat bazy danych programu Microsoft Access nie może odnaleźć obiektu „'Ala ma kota$'C6:F1019”. Upewnij się, że obiekt istnieje, a jego nazwa i ścieżka są podane poprawnie. Jeśli „'Ala ma kota$'C6:F1019” nie jest obiektem lokalnym, sprawdź połączenie sieciowe lub skontaktuj się z administratorem serwera.

Wygląda na to, że w tym przypadku nie można w zapytaniu użyć apostrofów.

2. Jeżeli arkusz ma nazwę " Ala ma kota" (spacja przed Ala), a w powyższym kodzie nic nie zmienię:

Cytat:

arg = "SELECT * FROM [" & sheet & "$" & ref & _ IIf(InStr(ref, ":") = 0, ":" & ref, "") & "]"

to otrzymuję błąd:

Cytat:

Error -2147217900: Niewłaściwe nawiasy w nazwie ' Ala ma kota$C3:K5773'.

Jak bym się nie zakręcił, to zawsze d... z tyłu.

3. Natomiast nie ma problemu, by spacja(-e) występowała(-Y) na końcu nazwy arkusza.

Przypomnę, że nie mam wpływu na nazwy arkuszy.



Artik

[Marecki]

Znalazłem taki zapis:

Cytat:

Standardowe konwencje nazewnictwa. Zestaw reguł dotyczących nazewnictwa obiektów DAO. Nazwy mogą mieć do 64 znaków i mogą zawierać dowolną kombinację liter, cyfr, spacji i znaków specjalnych oprócz kropki (.), wykrzyknika (!), lewostronnego apostrofu (`) i nawiasów kwadratowych ([ ]). Dodatkowo na początku nazwy nie można używać spacji, a także znaków sterujących (o wartościach ASCII od 0 do 31).

Choć cytat odnosi się do DAO, to przypuszczam że mogło to być przeniesione ( ta spacja) do ADO i chyba się tego nie przeskoczy.
Pozostanie metoda tradycyjna - otwarcie pliku, pobranie danych, zamknięcie.

[Artik]

[frytek1986]

A mnie funkcja ADOGetValue działa, ale tylko w przypadku gdy plik z którego zasysam jest otwary (działa jak adr.pośr).. jak go zamkne to dostaje #ARD

Czym to może być spowodowane?

Musze doprecyzować. Nie działa dla plików .csv Dla tego samego pliku zapisanego jako xlsx działa. Można to jakoś poprawić?

[Artik]

Plik csv ma całkiem inną strukturę niż xls. To tylko plik tekstowy, w którym dane są oddzielone separatorami. Gdy otwierasz plik csv za pomocą Excela, program ten automatycznie dokonuje konwersji do pliku xls. Dlatego można odnieść wrażenie, że struktura csv jest taka jak xls. Ale wystarczy otworzyć csv w notatniku i już widać że tak nie jest.

Chcąc pobierać dane z csv należy użyć innego sterownika. Więcej znajdziesz tutaj, zwróć szczególną uwagę na fragment od So How Do I Use ADO to Query a Text File?.

Artik

[guziolek]

Chyba jestem jakiś upośledzony, bo nigdzie nie widzę gdzie w kodzie powinienem wpisać te argumenty

Kod:

p - scieżka ' f - nazwa pliku ' s - nazwa arkusza ' r - komórka lub obszar np. "A3", "A1:A10"

Orłem jakimś nie jestem jeśli chodzi o VBA, nawet amatorem można powiedzieć, ale zawsze raczej doszukiwałem się metodą prób i błędów gdzie i co wpisać, ale tutaj nie mam pojęcia.

[apollo]

Chcesz pobrać dane z zamkniętego pliku? Chyba tak skoro pytasz w tym temacie. W takim razie w pewnym momencie, gdzieś w kodzie, będziesz wywołał funkcję ADOGetValue, prawda? No ale funkcja wymaga 4 parametrów wejściowych, więc przy wywołaniu musisz podać te 4 parametry, prawda? Bo inaczej funkcja ADOGetValue będzie pytała: "Z której komórki (z którego obszaru) którego arkuszu w którym pliku na jakiej ścieżce mam pobrać dane, miszczu? Z koszu pod numerem 9 przy ul. ABC w mieście XYZ?"

Kod:

Dim Arr ... Arr = ADOGetValue(konkretna ścieżka, konkretna nazwa pliku, konkretna nazwa arkuszu, konkretny obszar) sprawdzanie zwrócanych danych i używanie