Monday, February 23, 2009

VBA Copy missing files

Public Sub CopyMissingFiles(sProdFiles As String, sOfflineFiles As String, sFileExt As String)
Dim i As Integer
Dim sDestination As String
Dim iFiles As Integer
'FileExt = "*.pdf"

'Add \ at end if missing
If Not Right(sProdFiles, 1) = "\" Then sProdFiles = sProdFiles & "\"
If Not Right(sOfflineFiles, 1) = "\" Then sOfflineFiles = sOfflineFiles & "\"

iFiles = 0

With Application.FileSearch
.NewSearch
.LookIn = sProdFiles
.FileName = sFileExt
.SearchSubFolders = False
.Execute
For i = 1 To .FoundFiles.Count
sDestination = Replace(.FoundFiles(i), sProdFiles, sOfflineFiles)
If Not FileOrDirExists(sDestination) Then
'Debug.Print .FoundFiles(i)
FileCopy .FoundFiles(i), sDestination
iFiles = iFiles + 1
End If
Next i
End With

If iFiles > 0 Then
MsgBox "Copied " & iFiles & " pdf files to " & sOfflineFiles, vbInformation
End If

End Sub

Sub test_CopyMissingFiles()
Call CopyMissingFiles("D:\ProdTest\Files\", "D:\files\", "*.pdf")
End Sub

Wednesday, February 11, 2009

VBA Ado Example for Sql Server 2000/2005 etc...

Just use {SQL Server} for most...
Note: Backward compatibility isn't set automatically on sql server 2005/2008!
So one can use Sql Server Native Client - note - you need to download and install this small component from codeplex.....on each client pc that will need it.
Or you use normal oledb connections which work fine, once named pipes is enabled on sql 2005/2008!

Public Function AdoExample() As Long
Dim AdoRs As ADODB.Recordset
Dim AdoCn As ADODB.Connection
Dim sCon As String
Dim sSql As String
Dim sServerName As String
Dim sDatabaseName As String

On Error GoTo err_AdoExample

sServerName = "Database Server"
sDatabaseName = "Database"

'sCon = "Driver=SQLNCLI.1;DataTypeCompatibility=80;Server=" & sServerName & ";database=" & sDatabaseName & ";trusted_connection=yes;"
sCon = "driver={SQL Server};Server=" & sServerName & ";Database=" & sDatabaseName & ";trusted_connection=Yes;"
'sCon = "driver={SQL Native Client};Server=" & sServerName & ";Database=" & sDatabaseName & ";trusted_connection=Yes;"
Set AdoCn = New ADODB.Connection
AdoCn.ConnectionString = sCon
AdoCn.Open
Set AdoRs = New ADODB.Recordset
sSql = "Select @Version as Version"
AdoRs.Open sSql, AdoCn ', adOpenDynamic, adLockOptimistic

debug.print AdoRs!Version

AdoRs.Close
AdoCn.Close

Exit Function

err_AdoExample:

MsgBox err.Description & vbNewLine & err.Number, vbInformation
Resume Next

End Function

Regards,
Tom Bizannes
Sydney, Australia
Database Development and Auditing