tag:blogger.com,1999:blog-12577962809506928862024-02-19T04:11:11.581+01:00VBA Mania<i>Non sunt multiplicanda entia sine necessitate</i>Anonymoushttp://www.blogger.com/profile/03990848058644591293noreply@blogger.comBlogger67125tag:blogger.com,1999:blog-1257796280950692886.post-24222652171809048212012-05-31T00:41:00.001+02:002012-05-31T00:53:47.319+02:00Iloczyn kartezjański w praktycznym przykładzieProsty przykład wykorzystania iloczynu kartezjańskiego do uzyskania wszystkich możliwych kombinacji ze zbioru danych.<br />
<br />
<a name='more'></a>Iloczyn kartezjański przydaje się w sytuacji gdy mamy kilka pozycji w słowniku i chcielibyśmy uzyskać wszystkie możliwe kombinacje w postaci np. kwerendy. Takim prostym a zarazem wdzięcznym przykładem będzie generator wypowiedzi naszego znanego polityka Stefana Niesiołowskiego stworzony na podstawie tego zestawienia:<br />
<div class="separator" style="clear: both; text-align: center;">
<a href="https://fbcdn-sphotos-a.akamaihd.net/hphotos-ak-ash3/547175_418794931473857_2108404422_n.jpg" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="185" src="https://fbcdn-sphotos-a.akamaihd.net/hphotos-ak-ash3/547175_418794931473857_2108404422_n.jpg" width="320" /></a></div>
<br />
Przykładowa baza danych zawierająca gotowe rozwiązanie znajduje się <a href="https://docs.google.com/open?id=0B5U-cr3zVOs2aGF1LUhnZG9MQTA">tutaj</a><br />
Dla nieposiadających Accessa 2010 proponuję przejrzeć wynik <a href="https://docs.google.com/spreadsheet/ccc?key=0ApU-cr3zVOs2dExKcDZSOHk5M2ZIRm8yMkxnSlNja2c">tutaj</a><br />
<br />
Kod SQL kwerendy zaś wygląda tak:<br />
<pre>SELECT Fraza
FROM (SELECT F1.fraza_01 + ' ' + F2.fraza_02 + ' ' + F3.fraza_03 + ' ' + F4.fraza_04 as Fraza
, Rnd(F1.id + F2.id + F3.id + F4.id) AS poz
from tab_frazy as F1, tab_frazy as F2, tab_frazy as F3, tab_frazy as F4
) AS F
ORDER BY poz DESC;</pre>
<br />Anonymoushttp://www.blogger.com/profile/03990848058644591293noreply@blogger.com1tag:blogger.com,1999:blog-1257796280950692886.post-15999493601596428012011-10-02T16:11:00.002+02:002011-10-03T17:47:22.004+02:00Szybkie sprawdzenie czy czy istnieje tabela o podanej nazwieADODB daje nam szereg możliwości. Jedną z nich jest możliwość pobrania informacji o strukturze bazy do której się podłączyliśmy. Przypadkiem szczególnym takich baz są bazy plikowe czyli popularne pliki mdb i accdb. Przypadkiem jeszcze bardziej szczególnym zaś są pliki Excel-a które można traktować jak pliki bazodanowe.<br />
<br />
Po podłączeniu do do tkiego pliku wystarczy uruchomić jedną metodę aby uzyskać pełen komplet informacji na temat tego zo znajduje się w środku a co najważniejsze nie musimy takiego pliku otwierać za pomocą Excel-a co mogło by być naprawdę czasochłonne.<br />
<br />
Metoda o której mówię to <b>OpenSchema</b>, zaś parametr odpowiadający za pobranie informacji o tabelach to: <b>adSchemaTables</b>.<br />
<br />
Przykładowy skrypt wykorzystujący ta metodę:<br />
<pre class="brush: vb;">Function GetTablesFromDatabase(Plik As String, Tabela As String) As Boolean
Dim aRs As ADODB.Recordset
Dim aConn As ADODB.Connection
Dim sConn As String
Dim e As Long
Dim ext As String
e = InStrRev(Plik, ".")
ext = Right(Plik, Len(Plik) - e)
Select Case ext
Case "xls"
sConn = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & Plik & "; Extended Properties =""Excel 8.0;HDR=Yes;IMEX=1"";"
Case "xlsx"
sConn = "Provider =Microsoft.ACE.OLEDB.12.0; Data Source =" & Plik & "; Extended Properties =""Excel 12.0 Xml;HDR=YES"";"
Case "mdb"
sConn = "Provider =Microsoft.Jet.OLEDB.4.0; Data Source =" & Plik & " ; User Id =admin; Password =;"
Case "accdb"
sConn = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source =" & Plik & ";"
End Select
On Error GoTo ERR_Handler:
Set aConn = New ADODB.Connection
With aConn
.Mode = adModeShareDenyNone
.CursorLocation = adUseServer
.ConnectionString = sConn
.Open
Set aRs = aConn.OpenSchema(adSchemaTables)
aRs.MoveFirst
aRs.Filter = "TABLE_NAME='" & Tabela & "'"
Do While Not aRs.EOF
If aRs.Fields("TABLE_NAME").Value = Tabela Then
GetTablesFromDatabase = True
Exit Do
End If
aRs.MoveNext
Loop
.Close
End With
Exit Function
ERR_Handler:
MsgBox Err.Description
If aConn.State > 0 Then
aConn.Close
End If
End Function</pre><br />
Przykładowe wykorzystanie<br />
<pre class="brush: vb;">Sub test()
Debug.Print GetTablesFromDatabase("E:\Dane\user\Moje Dokumenty\zeszyt1.xls", "Arkusz1$")
End Sub</pre><br />
Uzyskujemy w ten sposób informację o tym czy dany arkusz istnieje w bazie danych czy też nie.Anonymoushttp://www.blogger.com/profile/03990848058644591293noreply@blogger.com1tag:blogger.com,1999:blog-1257796280950692886.post-1664031766471612162011-10-02T15:16:00.003+02:002011-10-03T17:47:51.116+02:00Zrzut danych z bazy do pliku tekstowegoNieraz stajemy przed wyzwaniem jak sobie poradzić w przypadku braku jakiegoś narzędzia na naszym komputerze. Z doświadczenia wiem że w korporacjach komputery są dosyć rygorystycznie ograniczane pod kątem możliwości instalacji aplikacji, co może niestety dosyć utrudnić życie. Dlatego też trzeba często kombinować jak tu sobie poradzić w takiej ekstremalnej sytuacji. Dobrym przykładem moze być zrzut danych z bazy do pliku tekstowego. Do wielu baz danych są dostarczane odpowiednie narzędzia jak np. BCP.EXE albo SQLCMD.EXE do MSSQL-a. Problem w tym że trzeba te narzędzia zainstalować. Rozwiązaniem tego problemu może być prosty skrypt w VBS-e pobierający dane z bazy i zrzucający do pliku. Pozwoliłem sobie coś takiego napisać:<br />
<br />
<pre class="brush: vb;">Dim aConn, sConn , aRs, sSQL
Dim sPath
Dim oFld, sHeader, bHeader, sContent, sDelimiter
Dim sCharset
dim oArgs, oArg, sArg
dim oStdOut
Const adTypeText = 2
Const adSaveCreateOverWrite = 2
set oArgs=wscript.Arguments
Set oStdOut = WScript.StdOut
sPath = ""
sCharset = "utf-8"
sDelimiter = ";"
bHeader = 0
For Each oArg In oArgs
sArg = fGetParmName(oArg)
select case sArg
case "Sql", "S"
sSQL = fGetParmValue(oArg)
case "Path", "P"
sPath = fGetParmValue(oArg)
case "Conn", "C"
sConn = fGetParmValue(oArg)
case "Charset", "A"
sCharset = fGetParmValue(oArg)
case "Header" , "H"
bHeader = fGetParmValue(oArg)
case "Delimiter", "D"
sDelimiter = fGetParmValue(oArg)
End Select
Next
On Error Resume Next
Err.Clear
Set aConn = CreateObject("ADODB.Connection")
aConn.Open sConn
If Err.Number <> 0 Then call sError
Set aRs = aConn.Execute(sSQL)
If Err.Number <> 0 Then call sError
aRs.MoveFirst
If Err.Number <> 0 Then call sError
if bHeader = "Yes" Then
For Each oFld In aRs.Fields
sHeader = sHeader & oFld.Name & sDelimiter
Next
sHeader = Left(sHeader, Len(sHeader) - 1) & Chr(13) & Chr(10)
End If
sContent = sHeader & aRs.GetString(, , sDelimiter)
If Err.Number <> 0 Then call sError
if sPath<> "" Then
ExportToFile sPath, sContent
Else
oStdOut.Write sContent
end if
aConn.Close
If Err.Number <> 0 Then call sError
set oStdOut = Nothing
Set aRs = Nothing
Set aConn = Nothing
function fGetParmName (sIn)
fGetParmName= left(sIn, InStr(sIn,":") -1 )
if left(fGetParmName,1) ="/" Then fGetParmName = mid(fGetParmName,2)
End Function
function fGetParmValue (sIn)
fGetParmValue= mid(sIn, InStr(sIn,":") + 1 )
End Function
sub sError
Wscript.Echo Err.Description
On Error GoTo 0
Err.Clear
Wscript.Quit
End Sub
sub ExportToFile (sPath, sContent)
Dim aStream 'As ADODB.Stream
Set aStream = CreateObject("ADODB.Stream")
With aStream
.Open
.Type = adTypeText
.Charset = sCharset
If Err.Number <> 0 Then call sError
.Position = 0
.WriteText sContent
If Err.Number <> 0 Then call sError
.SaveToFile sPath, adSaveCreateOverWrite
If Err.Number <> 0 Then call sError
End With
Set aStream = Nothing
End Sub</pre><br />
Skrypt ten można uruchomić w następujący sposób:<br />
<br />
<pre>eksport.vbs /Sql:"SELECT * FROM dbo.v_struktura_akt" /Conn:"DRIVER=SQL Server Native Client 10.0;SERVER=MASZYNA;UID=username;Trusted_Connection=Yes;WSID=MASZYNA;DATABASE=baza_danych;LANGUAGE=polski;" /Path:"E:\Roboczy\wynik.csv"</pre><br />
dostępne są następujące parametry:<br />
<br />
<b>/SQL:"select * from tabela"</b> - zapytanie które chcemy uruchomić<br />
<b>/Conn:"DRIVER=SQL Server....."</b> - ciąg połączenia do bazy danych, zaletą tego rozwiązania jest to że możemy pobrać dane z praktycznie dowolnej bazy danych<br />
<b>/Path:"d:\katalog\plik.csv"</b> - ścieżka do pliku w którym chcemy przechowywać wynik. W przypadku gdy nie podamy pliku wynik zostanie przekierowany do strumienia <b>STDOUT</b><br />
<b>/Charset:"utf-8"</b> - domyślny marametr strony kodowej w której zapiszemy plik. Standardowo jest utf-8, ale można zastosować dowolną stronę kodową obsługiwaną przez ADODB.Stream np. windows-1250<br />
<b>/Header:"Yes"</b> - dodaje wiersz z nagłówkami<br />
<b>/Delimiter:";"</b> - ustala znak podziału poszczególnych kolumn<br />
<br />
Mała uwaga: jeżeli chcemy wyłączyć Banner w programie CSCRIPT<br />
<br />
<pre>Microsoft (R) Windows Script Host Version 5.7
Copyright (C) Microsoft Corporation. All rights reserved.</pre><br />
Wykonajmy polecenie<br />
<br />
<pre>cscript //NoLogo //S</pre>Anonymoushttp://www.blogger.com/profile/03990848058644591293noreply@blogger.com0tag:blogger.com,1999:blog-1257796280950692886.post-81273731161094071402011-05-01T18:16:00.003+02:002011-05-01T18:25:36.942+02:00Automatyczne łączenie aplikacji i bibliotek w jeden plik podczas kompilacjiZastanawiałem się w jaki sposób mógł bym sprawić żeby mój projekt odwołujący się do kilku bibliotek zewnętrznych nie był zbieraniną plików a jednym wygodnym do użycia plikiem. Głównym motywatorem takiego działania jest fakt że to aplikacji przeznaczona do pracy z linii poleceń.<br />
<br />
Żeby wykonać scalić wszystkie pliki w jedną całość skorzystałem z narzędzia ILMerge.exe dostępnego na stronach <a href="http://www.microsoft.com/downloads/en/details.aspx?familyid=22914587-B4AD-4EAE-87CF-B14AE6A939B0&displaylang=en">Microsoft</a>. Po ściągnięciu i zainstalowaniu możemy korzystać z tego narzędzia standardowo za pomocą linii poleceń i np. wykonać komendę:<br />
<br />
<pre>ilmerge /target:exe /out:Aplikacja.exe
Program.exe ClassLibrary1.dll ClassLibrary2.dll</pre><br />
Dzięki takiej operacji z trzech plików robi nam się jeden, ale tu uwaga - parametr <b>/target:exe</b> wskazuje na to że plik wynikowy będzie uruchamiany z linii poleceń, można też użyć opcji <b>/target:winexe</b> - dzięki czemu stworzymy aplikację okienkowa lub <b>/target:library</b> - dzięki czemu stworzymy bibliotekę.<br />
<br />
Oczywiście takie łączenie da nam jak najbardziej prawidłowy plik, lecz na dłuższą metę nie jest to wygodne. Rozwiązaniem było by takie zmodyfikowanie naszego projektu aby łączenie nastąpiło automatycznie po skomplikowaniu projektu. Taką możliwość możemy uzyskać dzięki ręcznej modyfikacji pliku projektu *.vbproj polegającej na dodaniu następującej sekcji:<br />
<br />
<a href="http://pastebin.com/L1eGGKYP">http://pastebin.com/L1eGGKYP</a><br />
<br />
Taka konstrukcja sprawi że po wykonaniu opeacjii Build zostanie wykonana komenda ILMerge z parametrami. Dodatkowo dodałem parametr /targetplatform:v4,C:\Windows\Microsoft.NET\Framework\v4.0.30319 sprawiający że ILMerge bedzie działał z .NET w wersji 4.0<br />
<br />
Dodanie takiej sekcji działa również w pliku projektu stworzonego w wersji Visual Studio Express .Anonymoushttp://www.blogger.com/profile/03990848058644591293noreply@blogger.com0tag:blogger.com,1999:blog-1257796280950692886.post-15947508417691727142011-04-19T16:44:00.001+02:002011-04-19T16:45:02.861+02:00Wielokrotny wybór w dialekcie JET SQL (Access)Często zdarza mi się korzystać z konstrukcji IIF(warunek,wartość dla prawda,wartość dla fałsz) z pozycji kwerend w Access-e. Taka przykładowa kwerenda mogła by wyglądać np. tak:<br />
<pre class="brush: sql;">SELECT t1.pole, IIF(t2.pole_w = 'TAK', 1,0) as FLAGA
FROM TABELA_1 as t1 join TABELA_2 as t2 on t1.id = t2.id
</pre><br />
Problem zaczyna się w momencie gdy musimy sprawdzić kilka niezależnych warunków i na podstawie takiego wyboru określić wynik końcowy. Oczywiście można zagnieżdżać IIF-y, ale to nie jest ani ładne, ani czytelne a tym bardziej wygodne. Idealnym rozwiązaniem było by zastosowanie CASE WHEN .... THEN .... ELSE END, ale JET SQL nie udostępnia nam bezpośrednio tego typu rozwiązania. Daje nam za to coś podobnego i działającego de fakto tak samo. jest to instrukcja SWITCH. Nasz wcześniejszy przykład możemy sobie rozbudować np. tak<br />
<br />
<pre class="brush: sql;">SELECT t1.pole
, SWITCH(t2.pole_w = 'TAK', 1, t2.pole_w = 'NIE' ,0, t2.pole_w = 'NIE WIEM', -1, t2.pole_w = 'INNA ODPOWIEDŹ', -2) as FLAGA
FROM TABELA_1 as t1 join TABELA_2 as t2 on t1.id = t2.id
</pre><br />
W tym momencie jak widzimy mamy kilka opcji bez zbędnego komplikowania, ale to nie koniec możliwości ;)<br />
<br />
<pre class="brush: sql;">SELECT t1.pole
, SWITCH(t2.pole_w = 'TAK', 1, t2.pole_w = 'NIE' ,0, t2.pole_w = 'NIE WIEM', -1, t2.pole_w = 'INNA ODPOWIEDŹ', -2, t2.pole_w in ('A','B','C'), 'ABC' , 1=1, 'COKOLWIEK INNEGO') as FLAGA
FROM TABELA_1 as t1 join TABELA_2 as t2 on t1.id = t2.id
</pre><br />
<b>t2.pole_w in ('A','B','C')</b> - to klasyczne sprawdzenie czy element jest w podanym zbiorze<br />
<b>1=1</b> - to ostatni warunek logiczny będący zawsze prawdą i wykonany w momencie gdy którykolwiek z wcześniejszych nie został uwzględniony.<br />
<br />
I tu małą uwaga: jeżeli SWITCH natrafi na kryterium które jest spełnione to zwraca wartość i kończy sprawdzanie.<br />
<br />
Jako ciekawostkę podam że w instrukcji SWITCH można jako zbiór danych podzapytanie np.<br />
<br />
<b>t2.pole_w in (SELECT KLUCZ FROM SLOWNIK)</b><br />
<br />
a jak znam życie to pewnie można też dać podzapytanie skorelowane, ale sprawdzenie tego pozostawiam już czytelnikomAnonymoushttp://www.blogger.com/profile/03990848058644591293noreply@blogger.com0tag:blogger.com,1999:blog-1257796280950692886.post-37648859836971289462011-04-19T16:26:00.001+02:002011-04-19T16:27:34.183+02:00Mapowanie dysku sieciowego z pozycji T-SQL-aDziś pokażę w jaki prosty sposób zmapować dysk sieciowy z poziomu MSSQL-a. Jest to szczególnie przydatne w momencie jak chcemy pobrać jakiś plik ze zdalnego serwera zabezpieczonego za pomocą loginu i hasła np. w celu załadowania za pomocą BULK INSERT<br />
<br />
<br />
<pre class="brush: sql;">xp_cmdshell 'cmd /c IF EXIST W: net use W: /DELETE'
xp_cmdshell 'cmd /c net use W: \\maszyna\udzial haslo /USER:maszyna\login /PERSISTENT:YES'
BULK INSERT dbo.tabela
FROM 'W:\plik.txt'
WITH
(
FIELDTERMINATOR =';',
ROWTERMINATOR ='\n',
FIRSTROW = 2,
CODEPAGE = 1250
)</pre><br />
jeżeli z jakiegoś powodu nie chcemy angażować dysku sieciowego, to wykorzystamy UNC<br />
<br />
<pre class="brush: sql;">xp_cmdshell 'cmd /c IF EXIST \\maszyna\udzial net use \\maszyna\udzial /DELETE'
xp_cmdshell 'cmd /c net use W: \\maszyna\udzial haslo /USER:maszyna\login /PERSISTENT:YES'
BULK INSERT dbo.tabela
FROM '\\maszyna\udzial\plik.txt'
WITH
(
FIELDTERMINATOR =';',
ROWTERMINATOR ='\n',
FIRSTROW = 2,
CODEPAGE = 1250
)</pre><br />
<div><br />
</div>Anonymoushttp://www.blogger.com/profile/03990848058644591293noreply@blogger.com1tag:blogger.com,1999:blog-1257796280950692886.post-6246067334824053912011-02-17T23:00:00.000+01:002012-05-14T21:35:02.916+02:00Synchronizacja tabeli z polem w Excelu<div class="separator" style="clear: both; text-align: center;"><object width="320" height="266" class="BLOGGER-youtube-video" classid="clsid:D27CDB6E-AE6D-11cf-96B8-444553540000" codebase="http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,40,0" data-thumbnail-src="http://i.ytimg.com/vi/PE59qxQy_5g/0.jpg">
<param name="movie" value="http://www.youtube.com/v/PE59qxQy_5g?f=user_uploads&c=google-webdrive-0&app=youtube_gdata" />
<param name="allowFullScreen" value="true" />
<param name="bgcolor" value="#FFFFFF" />
<embed width="320" height="266" src="http://www.youtube.com/v/PE59qxQy_5g?f=user_uploads&c=google-webdrive-0&app=youtube_gdata" type="application/x-shockwave-flash" allowFullScreen="true">
</embed></object></div>Taka mała magiczna sztuczka dla tych, którzy by chcieli bez użycia kodu VBA zsynchronizować tabelę w Excelu z filtrami umieszczonymi w polach.Anonymoushttp://www.blogger.com/profile/03990848058644591293noreply@blogger.com3tag:blogger.com,1999:blog-1257796280950692886.post-7537601373565191172011-02-17T21:56:00.000+01:002011-02-17T21:56:56.893+01:00Gwiazdki w InputBox-eCzytając dzisiaj posty na forum dyskusyjnym <a href="http://www.goldenline.pl/forum/2243476/gwiazdki-w-inputboxie/s/1#40772278">goldenline.pl</a> natrafiłem na bardzo elegancki sposób realizacji tytułowych gwiazdek w InputBox-e. Rozwiązanie opiera się o API Windows i wygląda następująco:<br />
<br />
<pre class="brush: vb;">Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
ByVal ncode As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Function GetModuleHandle Lib "kernel32" _
Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" (ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long
Private Declare Function SendDlgItemMessage Lib "user32" _
Alias "SendDlgItemMessageA" (ByVal hDlg As Long, _
ByVal nIDDlgItem As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Declare Function GetClassName Lib "user32" _
Alias "GetClassNameA" (ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const HC_ACTION = 0
Private hHook As Long
Public Function NewProc(ByVal lngCode As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Dim RetVal
Dim strClassName As String
Dim lngBuffer As Long
If lngCode < HC_ACTION Then
NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
Exit Function
End If
strClassName = String$(256, " ")
lngBuffer = 255
If lngCode = HCBT_ACTIVATE Then
RetVal = GetClassName(wParam, strClassName, lngBuffer)
If Left$(strClassName, RetVal) = "#32770" Then
SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
End If
End If
CallNextHookEx hHook, lngCode, wParam, lParam
End Function
Public Function InputBoxDK(Prompt, _
Optional Title, _
Optional Default, _
Optional XPos, _
Optional YPos, _
Optional HelpFile, _
Optional Context) As String
Dim lngModHwnd As Long
Dim lngThreadID As Long
lngThreadID = GetCurrentThreadId
lngModHwnd = GetModuleHandle(vbNullString)
hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
On Error Resume Next
InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)
UnhookWindowsHookEx hHook
End Function
Sub PasswordBox()
If InputBoxDK("Proszą wprowadzić hasło", "Wymagane hasło") <> "ania" Then
MsgBox "Niestety, to nie było prawidłowe hasło."
Else
MsgBox "Hasło prawidłowe! Zapraszamy."
End If
End Sub
</pre><br />
Moim skromnym zdaniem rozwiązanie jest świetne gdyż nie musimy korzystać z dedykowanego userforma, co w wielu przypadkach jest idealnym rozwiązaniem.Anonymoushttp://www.blogger.com/profile/03990848058644591293noreply@blogger.com0tag:blogger.com,1999:blog-1257796280950692886.post-21771873253303487842010-12-25T00:51:00.001+01:002010-12-25T00:51:09.167+01:00Nowość w CreateWorkspace wprowadzona od wersji Access 2007<a href="http://msdn.microsoft.com/en-us/library/bb221018(v=office.12).aspx"> <br />
<blockquote>CreateWorkspace Method [Access 2007 Developer Reference]</a>: "ODBCDirect workspaces are not supported in Microsoft Office Access 2007. Setting the type argument to <span style="font-weight:bold;">dbUseODBC</span> will result in a run-time error. Use ADO if you want to access external data sources without using the Microsoft Access database engine."</blockquote><br />
<br />
Oznacza to ni mniej ni więcej to że nie da się wykonać następującego kodu: <br />
<br />
<pre class="brush: vb;">Sub dbOpenDynamicX()
Dim wrkMain As Workspace
Dim conMain As Connection
Dim qdfTemp As QueryDef
Dim rstTemp As Recordset
Dim strSQL As String
Dim intLoop As Integer
' Create ODBC workspace and open connection to
' SQL Server database.
Set wrkMain = CreateWorkspace("ODBCWorkspace", _
"admin", "", dbUseODBC)
' Note: The DSN referenced below must be configured to
' use Microsoft Windows NT Authentication Mode to
' authorize user access to the Microsoft SQL Server.
Set conMain = wrkMain.OpenConnection("Publishers", _
dbDriverNoPrompt, False, _
"ODBC;DATABASE=pubs;DSN=Publishers")
' Open dynamic-type recordset.
Set rstTemp = _
conMain.OpenRecordset("authors", _
dbOpenDynamic)
With rstTemp
Debug.Print "Dynamic-type recordset: " & .Name
' Enumerate records.
Do While Not .EOF
Debug.Print " " & !au_lname & ", " & _
!au_fname
.MoveNext
Loop
.Close
End With
conMain.Close
wrkMain.Close
End Sub </pre><br />
Skutkuje to tym że nie możemy stworzyć obiektu <span style="font-weight:bold;">wrkMain</span> służącego nam podczas otwierania połączania. <br />
Jaki z tego płynie wniosek: piszmy od razu w ADO jeżeli zamierzamy korzystać z zewnętrznej bazy danych w naszym projekcie Accessowym.Anonymoushttp://www.blogger.com/profile/03990848058644591293noreply@blogger.com0tag:blogger.com,1999:blog-1257796280950692886.post-88426035924850711272010-11-01T22:41:00.001+01:002010-11-01T22:47:33.041+01:00Design navigation UI with Access 2010<object style="background-image:url(http://i3.ytimg.com/vi/vkMzkhVfK6Y/hqdefault.jpg)" width="425" height="344"><param name="movie" value="http://www.youtube.com/v/vkMzkhVfK6Y?fs=1&hl=pl_PL"><param name="allowFullScreen" value="true"><param name="allowscriptaccess" value="always"><embed src="http://www.youtube.com/v/vkMzkhVfK6Y?fs=1&hl=pl_PL" width="425" height="344" allowScriptAccess="never" allowFullScreen="true" wmode="transparent" type="application/x-shockwave-flash"></embed></object><br />
<br />
Kolejna bardzo ciekawa funkcja moim zdaniem w Accessie. Dzięki takiej kontrolce w łatwy sposób możemy budować nawet zaawansowane struktury w bardzo szybki i intuicyjny sposób.Anonymoushttp://www.blogger.com/profile/03990848058644591293noreply@blogger.com0tag:blogger.com,1999:blog-1257796280950692886.post-69797403696771939632010-11-01T22:14:00.002+01:002010-11-01T22:47:08.082+01:00Access 2010 - The Web Browser Control Feature<object style="background-image:url(http://i4.ytimg.com/vi/GHoy6hsAltc/hqdefault.jpg)" width="425" height="344"><param name="movie" value="http://www.youtube.com/v/GHoy6hsAltc?fs=1&hl=pl_PL"><param name="allowFullScreen" value="true"><param name="allowscriptaccess" value="always"><embed src="http://www.youtube.com/v/GHoy6hsAltc?fs=1&hl=pl_PL" width="425" height="344" allowScriptAccess="never" allowFullScreen="true" wmode="transparent" type="application/x-shockwave-flash"></embed></object><br />
<br />
Nowe kontrolki takie jak prezentowany Web Browser otwierają zupełnie nowe możliwości przez starym poczciwym Accessem :)<br />
<br />
z ciekawostek mogę podać fakt w jaki sposób mozemy operować tą kontrolką, która de fakto jest osadzonym internet explorerem. Zrobimy to dzięki obiektowi Object znajdującego się wewnątrz kontrolki Web Browser-a. np.<br />
<pre class="brush: vb;">Me.myWebBrowserControl.Object.Navigate myUrl</pre>pozwoli nam na swobodne nawigowanie do dowolnie wybranej strony. Korzystanie z metody POST również będzie się odbywać za pomocą tego obiektu.Anonymoushttp://www.blogger.com/profile/03990848058644591293noreply@blogger.com0tag:blogger.com,1999:blog-1257796280950692886.post-11063054886907173292010-10-17T23:26:00.003+02:002010-10-17T23:35:03.813+02:00Wysyłanie maila za pomocą CDO<p>Biblioteka CDO obecna w systemie Windows świetnie nadaje się do masowego wysyłania wiadomości mailowych za pomocą za pomocą wszelakiej maści skryptów. Przykładowy skrypt wysyłający wiadomość HTML z osadzonym obrazkiem i dwoma załącznikami znajduje się w kodzie poniżej:</p><div style="padding-bottom: 0px; margin: 0px; padding-left: 0px; padding-right: 0px; display: inline; float: none; padding-top: 0px" id="scid:f32c3428-b7e9-4f15-a8ea-c502c7ff2e88:fb0b552a-d473-49f8-a304-f07ac66bd009" class="wlWriterEditableSmartContent"><pre class="brush: vb;">Option Explicit
' skracamy sobie trochę długość w ustawieniach
Private Const cdo_conf As String = "http://schemas.microsoft.com/cdo/configuration/"
Const cdoSendUsingPickup = 1 'wyslij wiadomość do katalogu z którego podejmie ją serwer
Const cdoSendUsingPort = 2 ' wysyłaj wiadomości na port serwer-a
Const cdoAnonymous = 0 'brak
Const cdoBasic = 1 'jawny tekst
Const cdoNTLM = 2 'NTLM
Const cdoRefTypeId = 0
Const cdoRefTypeLocation = 1
Sub CDO_Mail_Small_Text()
Dim strbody As String
Dim iMsg As Object 'CDO.Message
Dim iConf As Object 'CDO.Configuration
Dim Flds As Object
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
' ustawienie parametrów serwera z którego korzystamy
With Flds
.Item(cdo_conf & "sendusername") = "user" 'login
.Item(cdo_conf & "sendpassword") = "xxxxxx" 'hasło
.Item(cdo_conf & "smtpserver") = "poczta.o2.pl" 'serwer SMTP
.Item(cdo_conf & "smtpserverport") = 465 ' port
.Item(cdo_conf & "sendusing") = cdoSendUsingPort 'metoda wysyłania
.Item(cdo_conf & "smtpauthenticate") = cdoBasic 'metoda uwieżytelnienia
.Item(cdo_conf & "smtpusessl") = 1 ' kodowany kanał
.Update
End With
strbody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"
With iMsg.Fields
' priorytet
.Item("urn:schemas:mailheader:X-MSMail-Priority") = "High" ' Dla Outlook 2003
.Item("urn:schemas:mailheader:X-Priority") = 2 ' Dla Outlook 2003 i innych np. Thunderbird-a
.Item("urn:schemas:httpmail:importance") = 2 ' Dla Outlook Express
' własny nagłówek
.Item("urn:schemas:mailheader:X-myfield") = "Email-Okay"
.Update
End With
With iMsg
Set .Configuration = iConf
' wielu odbiorców
.To = "user@gazeta.pl; user@gmail.com"
.CC = "" ' kopia
.BCC = "" ' ukryta kopia
.From = "user@o2.pl" ' istotne wysyłamy w kontekście konkretnego konta pocztowego
.Subject = "Raport" ' temat
.TextBody = strbody ' wiadomość w postaci tekstu, jest niezależna od tej w HTML-u
' wiadomość w HTML-u. obrazek jako źródło ma ustawione cid:header.gif - ten sam nagłówek został dodany w kolejnej sekcji
.HTMLBody = "<img src='cid:header.gif'><br>" & Replace(strbody, vbNewLine, "<BR>" & vbNewLine)
' dodanie załącznika
.AddAttachment "d:\msg\indeksowanie.xlsm"
.AddAttachment "d:\msg\import_status.xlsx"
' dodaie obrazka wykorzystanego w wiadomości HTML
.AddRelatedBodyPart "d:\msg\header.gif", "header.gif", cdoRefTypeId
.Send ' wyślij
End With
End Sub</pre></div><p>Jeżeli chcielibyśmy manipulować zawartością w zależności od adresata to od razu powiem – jest taka możliwość o czym opowiem w kolejnym odcinku.</p>Anonymoushttp://www.blogger.com/profile/03990848058644591293noreply@blogger.com1tag:blogger.com,1999:blog-1257796280950692886.post-840672027337083892010-10-17T22:51:00.001+02:002010-10-17T22:51:29.869+02:00WAMP i SKYPE<p align="justify">Platforma WAMP nie chce działać popranie w momencie gdy jakiś program zajmie jej porty 80 i 443. Coś takiego może się zdarzyć jak korzystamy z programu SKYPE który domyślnie podczas startu nasłuchuje na tych portach. Możemy to wyłączyć w aplikacji SKYPE, tak aby nie mieć z tym problemu w przyszłości.</p> <p><a href="http://lh4.ggpht.com/_Om2Kdnd1Ulo/TLthyEtMkPI/AAAAAAAAAoA/Kzp2boAuUPs/s1600-h/skype_konfiguracja%5B6%5D.png"><img style="background-image: none; border-bottom: 0px; border-left: 0px; margin: ; padding-left: 0px; padding-right: 0px; display: block; float: none; border-top: 0px; border-right: 0px; padding-top: 0px" title="skype_konfiguracja" border="0" alt="skype_konfiguracja" src="http://lh4.ggpht.com/_Om2Kdnd1Ulo/TLthzGFwDrI/AAAAAAAAAoE/uawGxIV8BOg/skype_konfiguracja_thumb%5B4%5D.png?imgmax=800" width="202" height="177" /></a></p> <p>Po wyłączeniu tej opcji należy uruchomić ponownie Skyp-a, o czym jesteśmy informowani. Na końcu zaś możemy już uruchomić Apache bez żadnych problemów.</p> Anonymoushttp://www.blogger.com/profile/03990848058644591293noreply@blogger.com1tag:blogger.com,1999:blog-1257796280950692886.post-84200488534847039422010-09-21T12:56:00.001+02:002010-09-21T13:02:49.017+02:00Funkcja VBA do wyłuskiwania teksuW dzisiejszym odcinku pokażę gotową funkcję umożliwiającą wyłuskiwanie tekstu na podstawie wzorca RegExp. Funkcja ta jest niezwykle prosta, a zarazem niezwykle użyteczna, gdyż ma o wiele szersze możliwości niż standardowe rozwiązania obecne w VBA lub Excel-u.<br />
<pre class="brush:vb">Function RegExpString(sString As String, pattern As String, _
Optional iMath As Integer = 0, _
Optional bIgnoreCase As Boolean = True, _
Optional bGlobal As Boolean = True) As String
Dim oRegExp As Object
Dim oMatches As Object
On Error GoTo ERR_Handler:
If pattern = "" Then
RegExpString = ""
Exit Function
End If
If sString = "" Then
RegExpString = ""
Exit Function
End If
Set oRegExp = CreateObject("vbScript.RegExp")
With oRegExp
.IgnoreCase = bIgnoreCase
.Global = bGlobal
.pattern = pattern
Set oMatches = .Execute(sString)
End With
If oMatches.Count - 1 < iMath Then
RegExpString = ""
Exit Function
End If
RegExpString = oMatches(iMath).Value
END_Handler:
Set oRegExp = Nothing
Exit Function
ERR_Handler:
RegExpString = ""
Resume END_Handler:
End Function</pre><pre class="brush:vb"></pre>Parametry funkcji to:<br />
<ul><li><b>sString</b> - tekst w którym wyszukujemy </li>
<li><b>pattern</b> - Wzorzec wykorzystany do wyszukiwania </li>
<li><b>iMath</b> - numer przypisania w kolekcji ze wszystkimi pasującymi elementami. Może się okazać że mamy ich więcej niż jedno trafienie </li>
<li><b>bIgnoreCase</b> - Ignoruj wielkość liter </li>
<li><b>bGlobal</b> - badaj wszystkie możliwe kombinacje w ciągu</li>
</ul>Przykład wykorzystania to np.:<br />
<pre class="brush:vb">Debug.Print RegExpString("ala ma psa, a kot to fafik","ala ma ?(kota|psa)")</pre>Anonymoushttp://www.blogger.com/profile/03990848058644591293noreply@blogger.com0tag:blogger.com,1999:blog-1257796280950692886.post-26469608669955679362010-09-09T20:56:00.001+02:002010-09-09T20:56:55.051+02:00Eksport danych z MSSQL-a bezpośrednio do MySQL-aDziś pokażę w jaki prosty sposób wyeksportować dane za pomocą jednego polecenia SQL. Wykorzystamy do tego mechanizm LINKED SERVER obecny w MSSQL-u.<br />
Pierwszym krokiem jest stworzenie łącza do zdalnej maszyny:<br />
<pre class="brush:sql">/****** Object: LinkedServer [MYSQL] Script Date: 09/09/2010 20:33:31 ******/
IF EXISTS (SELECT srv.name FROM sys.servers srv WHERE srv.server_id != 0 AND srv.name = N'MYSQL')
EXEC master.dbo.sp_dropserver @server=N'MYSQL', @droplogins='droplogins'
GO
/****** Object: LinkedServer [MYSQL] Script Date: 09/09/2010 20:33:31 ******/
EXEC master.dbo.sp_addlinkedserver
@server = N'MYSQL',
@srvproduct=N'MySQL',
@provider=N'MSDASQL',
@provstr=N'Driver=MySQL ODBC 5.1 Driver;SERVER=localhost;UID=root;PWD=tajnehaslo;DATABASE=sprzedaz;PORT=3306;CHARSET=utf8'
/* For security reasons the linked server remote logins password is changed with ######## */
EXEC master.dbo.sp_addlinkedsrvlogin
@rmtsrvname=N'MYSQL',
@useself=N'True',
@locallogin=NULL,
@rmtuser=NULL,
@rmtpassword=NULL</pre><br />
załóżmy że mamy tabelkę w bazie zdefiniowaną jako:<br />
<pre class="brush:sql">CREATE TABLE [dbo].[tab_import](
[id] [int] IDENTITY(1,1) NOT NULL,
[O1] [varchar](30) NULL,
[L1] [varchar](70) NULL,
[O2] [varchar](30) NULL,
[L2] [varchar](70) NULL,
[O3] [varchar](30) NULL,
[L3] [varchar](70) NULL,
[O4] [varchar](30) NULL,
[L4] [varchar](70) NULL,
[O5] [varchar](30) NULL,
[L5] [varchar](70) NULL,
CONSTRAINT [PK_tab_import] PRIMARY KEY CLUSTERED ([id] ASC)
) ON [PRIMARY]</pre><br />
Posiadamy również tabelkę po stronie MySQL-a zdefiniowaną jaką<br />
<pre class="brush:sql">CREATE TABLE `tab_import` (
`id` int(11) NOT NULL AUTO_INCREMENT,
`O1` varchar(30) DEFAULT NULL,
`L1` varchar(70) DEFAULT NULL,
`O2` varchar(30) DEFAULT NULL,
`L2` varchar(70) DEFAULT NULL,
`O3` varchar(30) DEFAULT NULL,
`L3` varchar(70) DEFAULT NULL,
`O4` varchar(30) DEFAULT NULL,
`L4` varchar(70) DEFAULT NULL,
`O5` varchar(30) DEFAULT NULL,
`L5` varchar(70) DEFAULT NULL,
PRIMARY KEY (`id`)
) ENGINE=InnoDB DEFAULT CHARSET=utf8;</pre>i chcemy przetransferować dane z bazy MSSQl do bazy MySQL. Skorzystamy w takim przypadku z możliwości INSERT INTO ... SELECT<br />
<pre class="brush:sql">INSERT INTO openquery (MYSQL,'select * from test.tab_import where 1 = 0')
(O1, L1, O2, L2, O3, L3, O4, L4, O5, L5)
SELECT O1, L1, O2, L2, O3, L3, O4, L4, O5, L5
FROM tab_import AS tab_import_1</pre>Ciekawostką w tym układzie jest konstrukcja zagnieżdżonego SELECT-a wykorzystywanego przez OPENQUERY. warunek w tym zapytaniu filtruje wszystkie rekordy gdyż de fakto nie są one nam do niczego potrzebne. Podobna sztuczka nie jest wskazana w przypadku gdybyśmy chcieli wykonać DELETE lub UPDATE.Anonymoushttp://www.blogger.com/profile/03990848058644591293noreply@blogger.com0tag:blogger.com,1999:blog-1257796280950692886.post-39100012084553132032010-09-06T01:25:00.001+02:002010-09-06T01:26:05.218+02:00Formatowanie warunkowe<object height="344" style="background-image: url(http://i2.ytimg.com/vi/AyiciOeS5l4/hqdefault.jpg);" width="425"><param name="movie" value="http://www.youtube.com/v/AyiciOeS5l4?fs=1&hl=pl_PL"><param name="allowFullScreen" value="true"><param name="allowscriptaccess" value="always"><embed src="http://www.youtube.com/v/AyiciOeS5l4?fs=1&hl=pl_PL" width="425" height="344" allowscriptaccess="never" allowfullscreen="true" wmode="transparent" type="application/x-shockwave-flash"></embed></object><br />
Formatowanie warunkowe w Excel 2010Anonymoushttp://www.blogger.com/profile/03990848058644591293noreply@blogger.com0tag:blogger.com,1999:blog-1257796280950692886.post-27177142360729281192010-09-05T23:35:00.003+02:002010-09-13T23:22:26.286+02:00Dodatki i usprawnienia dla MSSQL w wersji Express<div style="margin-bottom: 0px; margin-left: 0px; margin-right: 0px; margin-top: 0px;">MSSQL w wersji Express to ciekawa baza, tyle że pozbawiona wielu użytecznych narządzi. Dzięki kilku dodatkom praca z tą wersją bazy będzie o wiele prostsza i zaoszczędzi nam mnóstwa pracy.</div><div style="margin-bottom: 0px; margin-left: 0px; margin-right: 0px; margin-top: 0px;">Automatyzacja</div><ul><li><a href="http://www.codeproject.com/Articles/93522/Automating-Backups-on-SQL-Server-Express-Version.aspx">Automating Backups on SQL Server Express Version - CodeProject</a></li>
<li><a href="http://expressmaint.codeplex.com/">ExpressMaint</a></li>
</ul><div style="margin-bottom: 0px; margin-left: 0px; margin-right: 0px; margin-top: 0px;">Shulder-y</div><ul><li><a href="http://www.sqlteam.com/article/scheduling-jobs-in-sql-server-express">Scheduling Jobs in SQL Server Express</a></li>
<li><a href="http://www.lazycoding.com/products.aspx">SQLScheduler</a></li>
<li><a href="http://weblogs.asp.net/alex_papadimoulis/archive/2005/11/10/Express-Agent-for-SQL-Server-Express_3A00_-Jobs_2C00_-Jobs_2C00_-Jobs_2C00_-and-Mail.aspx">Express Agent for SQL Server Express: Jobs, Jobs, Jobs, and Mail</a></li>
</ul><div style="margin-bottom: 0px; margin-left: 0px; margin-right: 0px; margin-top: 0px;">Dodatki</div><ul><li><a href="http://sites.google.com/site/sqlprofiler/">Profiler for Microsoft SQL Server 2005/2008 Express Edition</a></li>
<li><a href="http://weblogs.sqlteam.com/mladenp/archive/2007/07/01/60245.aspx">Enabling Database Mail on SQL Server Express</a></li>
</ul><div><div style="margin-bottom: 0px; margin-left: 0px; margin-right: 0px; margin-top: 0px;">Menadżery</div></div><div><ul><li><a href="http://toadforsqlserver.com/index.jspa">Toad</a></li>
</ul></div>Anonymoushttp://www.blogger.com/profile/03990848058644591293noreply@blogger.com0tag:blogger.com,1999:blog-1257796280950692886.post-12773074605777571432010-08-30T00:45:00.002+02:002010-08-30T08:25:58.733+02:00Określenie daty zakończenia miesiąca w SQL-uDziś pokażę jak określić koniec miesiąca dla dowolnej daty. Wykorzystam tu pewną sztuczkę związaną z dodawaniem dat za pomocą funkcji DATEADD oraz wyciąganiem części składowych za pomocą funkcji YEAR i MONTH.<br />
<pre class="brush:sql">declare @dstop as datetime
set @dstop = getdate()
set @dstop = dateadd(d,-1,dateadd(mm,1,convert(datetime,cast(year(@dstop) as nvarchar(4)) + '-' + RIGHT('0' + cast(MONTH(@dstop) as nvarchar(4)),2) + '-01',120)))
select @dstop</pre><br />
Algorytm postępowania jest następujący:<br />
Wyciągamy Rok i miesiąc i na podstawie tego sklejamy datę określającą pierwszy dzień miesiąca<br />
dodajemy miesiąc do tak otrzymanej daty<br />
dodajemy -1 dzień do otrzymanej wcześniej sumy<br />
<br />
Inna metoda to:<br />
<pre class="brush:sql">declare @dstop datetime
set @dstop = getdate() + 1
set @dstop = dateadd(d,-day(dateadd(m,1,@dstop)),dateadd(m,1,@dstop))
select @dstop</pre>Sposób ten zaprezentował kolega Bartosz Ślepowroński <a href="http://www.goldenline.pl/forum/1881692/miesiace-z-przedzialu-dat/s/2#35710136">w tym wątku</a><br />
<br />
Z powodzeniem ten sposób można zastosować w innych dialektach SQL np. JETAnonymoushttp://www.blogger.com/profile/03990848058644591293noreply@blogger.com0tag:blogger.com,1999:blog-1257796280950692886.post-50732624702597300142010-08-27T23:52:00.001+02:002010-08-27T23:54:23.455+02:00Sprawdzenie czy plik jest otwarty przez inny programZnalazłem ciekawy kawałek kodu w internecie do sprawdzenia czy dany plik nie został otwarty w innej aplikacji. np. plik Excel-a. Kod ten wykorzystuje API Windows.<br />
<pre class="brush:vb">Option Explicit
'===========================================
'http://www.xcelfiles.com/IsFileOpenAPI.htm
'===========================================
'// Note we use an Alias here as using the Actual
'// function name will not be accepted! ie underscore= "_lopen"
Private Declare Function lOpen _
Lib "kernel32" _
Alias "_lopen" ( _
ByVal lpPathName As String, _
ByVal iReadWrite As Long) _
As Long
Private Declare Function lClose _
Lib "kernel32" _
Alias "_lclose" ( _
ByVal hFile As Long) _
As Long
'// Don't use these...here for Info only
Private Const OF_SHARE_COMPAT = &H0
Private Const OF_SHARE_DENY_NONE = &H40
Private Const OF_SHARE_DENY_READ = &H30
Private Const OF_SHARE_DENY_WRITE = &H20
'// Use the Constant below
'// OF_SHARE_EXCLUSIVE = &H10
'// OPENS the FILE in EXCLUSIVE mode,
'// denying other processes AND the current process both read and write
'// access to the file. If the file has been opened in any other mode for read or
'// write access _lopen fails. This is important as if you open the file in the
'// current process = Excel BUT loose its handle
'// then you CANNOT open it again in the SAME session!
Private Const OF_SHARE_EXCLUSIVE = &H10
'If the Function succeeds, the return value is a File handle.
'If the Function fails, the return value is HFILE_ERROR = -1
Private Function IsFileAlreadyOpen(strFullPath_FileName As String) As Boolean
'// Ivan F Moala
'// http://www.xcelfiles.com
Dim hdlFile As Long
Dim lastErr As Long
hdlFile = -1
'// Open file for Read/Write and Exclusive Sharing.
hdlFile = lOpen(strFullPath_FileName, OF_SHARE_EXCLUSIVE)
'// If we can't open the file, get the last error.
If hdlFile = -1 Then
lastErr = Err.LastDllError
Else
'// Make sure we close the file on success!
lClose (hdlFile)
End If
'// Check for sharing violation error.
IsFileAlreadyOpen = (hdlFile = -1) And (lastErr = 32)
End Function
Private Function LastUser(strPath As String) As String
'// Code by Helen from http://www.visualbasicforum.com/index.php?s=
'// This routine gets the Username of the File In Use
'// Credit goes to Helen for code & Mark for the idea
'// Insomniac for xl97 inStrRev
'// Amendment 25th June 2004 by IFM
'// : Name changes will show old setting
'// : you need to get the Len of the Name stored just before
'// : the double Padded Nullstrings
Dim strXl As String
Dim strFlag1 As String, strflag2 As String
Dim i As Integer, j As Integer
Dim hdlFile As Long
Dim lNameLen As Byte
strFlag1 = Chr(0) & Chr(0)
strflag2 = Chr(32) & Chr(32)
hdlFile = FreeFile
Open strPath For Binary As #hdlFile
strXl = Space(LOF(hdlFile))
Get 1, , strXl
Close #hdlFile
j = InStr(1, strXl, strflag2)
#If Not VBA6 Then
'// Xl97
For i = j - 1 To 1 Step -1
If Mid(strXl, i, 1) = Chr(0) Then Exit For
Next
i = i + 1
#Else
'// Xl2000+
i = InStrRev(strXl, strFlag1, j) + Len(strFlag1)
#End If
'// IFM
lNameLen = Asc(Mid(strXl, i - 3, 1))
LastUser = Mid(strXl, i, lNameLen)
End Function
</pre>Wykorzystanie przykładowe znajduje się w kodzie poniżej:<br />
<pre class="brush:vb">Sub TestAPI()
'// We can use this for ANY FILE not just Excel!
Dim t As String
t = "C:\Users\Przemek\Documents\pivot from db.xls"
If IsFileAlreadyOpen(t) Then
MsgBox t & " is already Open" & vbCrLf & "By " & LastUser(t), vbInformation, "File in Use"
Else
MsgBox "File is NOT open", vbInformation
End If
End Sub</pre>Trzeba zaznaczyć że funkcje są zadeklarowane jako prywatne i nie będą widoczne poza modułem w który zostały wklejone. Jeżeli ktoś chciał by je wykorzystać w innym miejscu konieczna może się okazać zmiana Private na Public.Anonymoushttp://www.blogger.com/profile/03990848058644591293noreply@blogger.com0tag:blogger.com,1999:blog-1257796280950692886.post-14932154701913580182010-08-26T20:12:00.004+02:002010-08-27T23:54:43.619+02:00MSSQL i polskie nazwy miesięcy i dni tygodniaW MSSQL-u w bardzo prosty sposób można uzyskać poprawną polską nazwę miesiąca. wystarczy tylko wykonać prostą instrukcję przed wykonaniem głównego zapytania. Chodzi o wymuszenie języka w jakim będą prezentowane dane przez MSSQL. robimy to tak:<br />
<pre class="brush:sql">SET LANGUAGE Polish</pre>Zaś wykorzystanie możemy zobaczyć tutaj:<br />
<pre class="brush:sql">select DATENAME (mm,GETDATE()) as [miesiąc], DATENAME (dw,GETDATE()) as [dzień]</pre>Sprawdzenie aktualnego języka możemy za pomocą zmiennych systemowych <span style="font-weight:bold;">@@language</span> i <span style="font-weight:bold;">@@langid</span>.<br />
<pre class="brush:sql">SELECT @@language, @@langid</pre>No i możemy również zmienić domyślny język dla loginu za pomocą menagment Studio: Security -> Logins -> Wybrany login , właściwości -> General -> Default Language.<br />
<br />
<a onblur="try {parent.deselectBloggerImageGracefully();} catch(e) {}" href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjwWi6-X6v9IYidSe_X_wvAVYRAu1cWPhrEnS0qMI00a5Plz0G2KMc0tHxA-3Q8yN3FDtgJSolclwcHVidF1KYWsGDjM8Yomnl4P4iT9U3BwAIqookihKNy9Y9JhOwNg4woed1GtSuNRgc/s1600/zmiana_j%C4%99zyka.png"><img style="display:block; margin:0px auto 10px; text-align:center;cursor:pointer; cursor:hand;width: 320px; height: 287px;" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjwWi6-X6v9IYidSe_X_wvAVYRAu1cWPhrEnS0qMI00a5Plz0G2KMc0tHxA-3Q8yN3FDtgJSolclwcHVidF1KYWsGDjM8Yomnl4P4iT9U3BwAIqookihKNy9Y9JhOwNg4woed1GtSuNRgc/s320/zmiana_j%C4%99zyka.png" border="0" alt="" id="BLOGGER_PHOTO_ID_5509780676907156114" /></a><br />
Lub za pomocą T-SQL-a<br />
<pre class="brush:sql">ALTER LOGIN sa WITH DEFAULT_LANGUAGE = Polish;</pre>Pełną informację o dostępnych językach uzyskamy zaś po wykonaniu komendy:<br />
<pre class="brush:sql">select * from sys.syslanguages</pre>Anonymoushttp://www.blogger.com/profile/03990848058644591293noreply@blogger.com0tag:blogger.com,1999:blog-1257796280950692886.post-83976728351184854372010-08-13T11:12:00.001+02:002010-08-13T11:13:51.364+02:00Now Available: SQL Server Migration Assistant for MySQL! - Brian Swan - Site Home - MSDN Blogs<a href="http://blogs.msdn.com/b/brian_swan/archive/2010/08/12/now-available-sql-server-migration-assistant-for-mysql.aspx">Now Available: SQL Server Migration Assistant for MySQL! - Brian Swan - Site Home - MSDN Blogs</a><br />
<br />
Bardzo ciekawe narzędzie służące do migrowania bazy danych MySQL do MSSQL-a. Dzięki temu kreatorowi można wykonać to zadanie w miarę szybko i bezboleśnie.Anonymoushttp://www.blogger.com/profile/03990848058644591293noreply@blogger.com0tag:blogger.com,1999:blog-1257796280950692886.post-25312675890499955712010-08-09T07:51:00.001+02:002010-08-13T11:13:28.768+02:00Coding Horror: A Visual Explanation of SQL Joins<a href="http://www.codinghorror.com/blog/2007/10/a-visual-explanation-of-sql-joins.html">Coding Horror: A Visual Explanation of SQL Joins</a><br />
<br />
Bardzo proste wyjaśnienie istoty Joinów w SQL-uAnonymoushttp://www.blogger.com/profile/03990848058644591293noreply@blogger.com0tag:blogger.com,1999:blog-1257796280950692886.post-46677810148647026482010-07-18T14:50:00.002+02:002010-07-18T14:52:34.193+02:00Wykorzystanie wget.exe do pobierania danych raportowych<a href="http://vbamania.blogspot.com/2010/07/logowanie-do-formularza-web.html">W poprzednim poście</a> pisałem o możliwości pobrania danych ze strony która wymaga logowania za pomocą loginu i hasła wpisywanego do formularza. Rozwiązanie bazowało na kodzie w VBA, co w pewnych sytuacjach jest nieco kłopotliwe do wykorzystania.<br />
<br />
Dziś chciał bym przedstawić rozwiązanie bazujące na narzędziu <b>wget.exe</b> dostępnego dla platformy *nix jaki Windows. Narzędzie dla Windows jest do pobraniu np. <a href="http://gnuwin32.sourceforge.net/packages/wget.htm">tu</a>. Narzędzie to nie wymaga instalowania, wystarczy że skopujemy plik <b>wget.exe</b> do jakiegoś katalogu.<br />
<br />
Metoda jaką się posłużymy wymaga posiadania wiedzy o tym co jest przesyłane do strony z której chcemy coś pobrać. Przeglądarki webowe komunikują się z serwerami za pomocą komunikatów tekstowych które możemy podejrzeć za pomocą odpowiedniego narzędzia. Jednym z takich narzędzi może być rozszerzenie do przeglądarki Firefox: <a href="https://addons.mozilla.org/en-US/firefox/addon/3829/">LiveHeader</a>. Rozszerzenie to pokazuje pełną komunikację między przeglądarką a serwerem na poziomie nagłówków. Dzięki temu można podejrzeć co jest wysyłane do serwera WWW np. po naciśnięciu guzika wyślij lub loguj. Dla przykładu to co zaobserwujemy po kliknięciu Loguj w przeglądarce:<br />
<div class="separator" style="clear: both; text-align: center;"></div><div class="separator" style="clear: both; text-align: center;"><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEivd3WQIWOP8x4au_wkjGceILvLf3rJ67xOTl6FMgEnNTFW4GM7nkZmYqtmg48CnhfRuSRtHuS44KsRj5zDpqvFGj1KWXPnEVZ1eRG-z7D6nuwi05BZQZrr7wvi_ySnXyO9ZMF7t_jx3fo/s1600/01.png" imageanchor="1"><img border="0" height="239" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEivd3WQIWOP8x4au_wkjGceILvLf3rJ67xOTl6FMgEnNTFW4GM7nkZmYqtmg48CnhfRuSRtHuS44KsRj5zDpqvFGj1KWXPnEVZ1eRG-z7D6nuwi05BZQZrr7wvi_ySnXyO9ZMF7t_jx3fo/s320/01.png" width="320" /></a></div><div style="text-align: center;">Na tym rysunku widzimy adres strony jaką wywołaliśmy po wyciśnięciu Loguj</div><div style="text-align: center;"><br />
</div><div class="separator" style="clear: both; text-align: center;"><a href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjZb_mF_yf_SWdyx_4T4shA5kvjGUvJsdO0KOvxZkhPdpLn08bO7gVTcmQCeEC1ogxf6ovGkVYyWHizyP_Nl71T4x1TItaf6IsBKBz5hZXZoH5CssLk0rpwbW9f-PfmpmFV3vhbGAf7Lr8/s1600/02.png" imageanchor="1" style="margin-left: 1em; margin-right: 1em;"><img border="0" height="239" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjZb_mF_yf_SWdyx_4T4shA5kvjGUvJsdO0KOvxZkhPdpLn08bO7gVTcmQCeEC1ogxf6ovGkVYyWHizyP_Nl71T4x1TItaf6IsBKBz5hZXZoH5CssLk0rpwbW9f-PfmpmFV3vhbGAf7Lr8/s320/02.png" width="320" /></a></div><div style="text-align: center;">A tu widzimy jaki nagłówek został przesłany do serwera.</div><br />
Uzbrojeni w takie informacje możemy wykorzystać pewne specyficzne mechanizmy narzędzia wget.exe do zalogowania a następnie do pobrania raportu.<br />
<br />
Przykładowy skrypt takiej znajdujący się np. w pliku <b>webget.cmd</b> to:<br />
<pre class="brush:plain">@ECHO OFF
wget --save-cookies cookies.txt --post-data "login=janek&password=123456789" -q "http://localhost/index.php?k=auth&a=auth&target="
wget --load-cookies cookies.txt --post-data "filtr_1=201006&filtr_2=844&sekcja=b&raport_n=compl&=undefined" --output-document=raport.csv -q "http://localhost/?k=raporty&a=GetReport&content=xls"
</pre><br />
Wyjaśnienia mogą wymagać poszczególne opcje jakie zostały użyte podczas takiej operacji:<br />
<ul><li>--save-cookies cookies.txt - zapisuje wszystkie informacje pobrane podczas logowania do pliku</li>
<li>--post-data "dane=vos" - wysyła dane do serwera udając formularz. Dane które są w przykładzie pochodziły z rysunku 2</li>
<li>-q - wget.exe działa w trybie cichym, to znaczy że nie będzie wyświetlał wszystkich komunikatów</li>
<li>"http://strona/" - adres URL strony którą pobieramy</li>
<li>--load-cookies cookies.txt - pobieramy informacje o logowaniu z wcześniej przygotowanego pliku</li>
<li>--output-document=raport.csv - zapisujemy wynik w pliku o konkretnej nazwie</li>
</ul><br />
Proszę zauważyć że zarówno dane dla --post-data jaki zam adres URL znajdują się między znakami " " - jest to konieczne do prawidłowego działania skryptuAnonymoushttp://www.blogger.com/profile/03990848058644591293noreply@blogger.com0tag:blogger.com,1999:blog-1257796280950692886.post-21463268071468196982010-07-17T20:24:00.005+02:002010-07-17T20:49:04.144+02:00Szybkie przekodowanie pliku teksowegoCzęstą zmorą podczas pracy z plikami jest ich kodowanie. Czasem można sobie poradzić ręcznie jakimś prostym narzędziem np. <b>Notepad++</b>, czasem importujemy plik do Access-a i eksportujemy w żądanym kodowaniu. Te metody się sprawdzają do momentu gdy nie zderzymy się z plikiem wielkości ~1GB. Cóż można wtedy zrobić? Ano skorzystać z dobrodziejstw darmowego narzędzia ICONV dla platformy <b>Win32</b> czyli Windowsa.<br />
Pierwotnie narzędzie to było dostępne dla systemów rodziny *nix, lecz w chwili obecnej możemy się cieszyć że jest dostępne też dla nas szarych użytkowników okieek.<br />
<br />
Pliki wykonywalne Iconv można ściągnąć z adresu: <a href="http://gnuwin32.sourceforge.net/packages/libiconv.htm">http://gnuwin32.sourceforge.net/packages/libiconv.htm</a>. Do wyboru mamy paczkę zip lub instalator exe. W zależności od wyboru ściągamy żądany plik i wypakowywujemy lub instalujemy.<br />
<br />
Załóżmy że plik iconw.exe znajduje się w katalogu: c:\dekoder\, zaś pliki do dekodowania znajdują się w katalogu d:\pliki\. To jak wykorzystać to narzędzie do tego żeby przekodować nasze pliki np. ze strony kodowej UTF-8 do CP1250 (Strona kodowa Windows). Należy wykonać polecenie z wiersza poleceń:<br />
<br />
<pre class="brush:plain">c:\dekoder\iconv.exe -f UTF-8 -t CP1250 d:\pliki\plik.txt > d:\pliki\plik.cp1250.txt</pre><br />
Konstrukcja taka to proste wykonanie instrukcji iconv z przekierowaniem strumienia ">" do nowego pliku. Jest niezwykle wydajna i na średniej klasy sprzęcie przekodowanie pliku o wielkości setek megabajtów zajmuje tylko kilkanaście sekund.<br />
<br />
Lista dostępnych stron kodowych jest dostępna po wykonaniu polecenia:<br />
<pre class="brush:plain">c:\dekoder\iconv.exe -l </pre><br />
Jednym z ciekawszych zastosowań takiej metody jest przekodowanie pliku przed importem do MSSQl-a. Jest to konieczne gdyż MSSQL nie wspiera tak jakbyśmy chcieli. Cóż można zrobić? ano można użyć procedury systemowej <b>xp_cmdshell</b> to przekonwertorownia pliku.<br />
<br />
<pre class="brush:sql">declare @cmd varchar(2000)
set @cmd = 'c:\dekoder\iconv.exe -f UTF-8 -t CP1250 d:\pliki\plik.txt > d:\pliki\plik_cp1250.txt'
exec xp_cmdshell @cmd
</pre><br />
Jeżeli nie będziemy mieli aktywnej procedury <b>xp_cmdshell</b> możemy ją włączyć w następujący sposób:<br />
<pre class="brush:sql">EXEC master.dbo.sp_configure 'show advanced options', 1
RECONFIGURE
EXEC master.dbo.sp_configure 'xp_cmdshell', 1
RECONFIGURE
</pre>Anonymoushttp://www.blogger.com/profile/03990848058644591293noreply@blogger.com1tag:blogger.com,1999:blog-1257796280950692886.post-67407752627549076502010-07-03T22:42:00.000+02:002010-07-03T22:42:46.789+02:00Konwertowanie UTF-8 do Unicode w VBAKiedyś znalazłem kod do konwertowania tekstu w UTF-8 do Unicode. Przydaje się to czasem podczas przetwarzania danych ze stron web.<br />
<br />
<pre class="brush:vb">Private Const CP_UTF8 = 65001
Private Declare Function MultiByteToWideChar Lib "kernel32" ( _
ByVal CodePage As Long, ByVal dwFlags As Long, _
ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, _
ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Public Function sUTF8ToUni(bySrc() As Byte) As String
' Converts a UTF-8 byte array to a Unicode string
Dim lBytes As Long, lNC As Long, lRet As Long
lBytes = UBound(bySrc) - LBound(bySrc) + 1
lNC = lBytes
sUTF8ToUni = String$(lNC, Chr(0))
lRet = MultiByteToWideChar(CP_UTF8, 0, VarPtr(bySrc(LBound(bySrc))), lBytes, StrPtr(sUTF8ToUni), lNC)
sUTF8ToUni = Left$(sUTF8ToUni, lRet)
End Function</pre>Anonymoushttp://www.blogger.com/profile/03990848058644591293noreply@blogger.com0