Month: May 2006

Creating Folders with MkDir

Posted on by Dick Kusleika

Scott wants to create folders based on the information in certain cells. I suggest the MkDir function.

Check out the line below “Make sure base folder exits”. Is that the best way to do that. For some reason I thought there was a problem with that method, but I can’t think of what it was.

Sub StartHere()
   
    Dim rCell As Range, rRng As Range
   
    Set rRng = Sheet1.Range(“A1:A2”)
   
    For Each rCell In rRng.Cells
        CreateFolders rCell.Value, “C:Test”
    Next rCell
       
End Sub
 
Sub CreateFolders(sSubFolder As String, ByVal sBaseFolder As String)
   
    Dim sTemp As String
   
    ‘Make sure the base folder is ready to have a sub folder
    ‘tacked on to the end
    If Right(sBaseFolder, 1) <> “” Then
        sBaseFolder = sBaseFolder & “”
    End If
   
    ‘Make sure base folder exists
    If Len(Dir(sBaseFolder, vbDirectory)) > 0 Then
        ‘Replace illegal characters with an underscore
        sTemp = CleanFolderName(sSubFolder)
        ‘See if already exists: Thanks Dave W.
        If Len(Dir(sBaseFolder & sTemp)) = 0 Then
            ‘Use MkDir to create the folder
            MkDir sBaseFolder & sTemp
        End If
    End If
   
End Sub
 
Function CleanFolderName(ByVal sFolderName As String) As String
   
    Dim i As Long
    Dim sTemp As String
   
    For i = 1 To Len(sFolderName)
         Select Case Mid$(sFolderName, i, 1)
            Case “/”, “”, “:”, “*”, “?”, “< “, “>”, “|”
                sTemp = sTemp & “_”
            Case Else
                sTemp = sTemp & Mid$(sFolderName, i, 1)
        End Select
    Next i
   
    CleanFolderName = sTemp
   
End Function

img: excel range and windows folder showing new sub folders

2007 Microsoft Office system Beta

Posted on by Dick Kusleika

Note the lower case “s”. I’m such a good shill.

Today Microsoft announced that they would be conducting an experiment to see if their beta serves could be made to explode. To achieve this seemingly impossible result, they announced the public beta for not one, not two, but three products at the same time. Not just any products, mind you, but their three most popular products.

One of those products is known as 2007 Microsoft Office system, but many “retailers” on the streets of Hong Kong are referring to it as Office 2007 Super Happy Fun. I urge all of you to download this beta as soon as possible. I won’t be attempting it until Thursday night and it would be a big help if you all got out of my way by then.

You can read the press release.

If you just want the highlights, though, here they are:

He demonstrated how [these products] will drive innovation across the industry and support the rich ecosystem of hardware manufacturers…

Ecosystem? Honestly, do these guys even consider the meaning of the words they use? Or do they just string a bunch together that sound good? The sooner the adjective “rich” is out of the Microsoft lexicon, the better. And just how did he “demonstrate” all this?

Did I say they? Well there was only one highlight and that was a bit of a stretch.

Name Manager 4: Last call before release

Posted on by jkpieterse

Hi all,

In this post I announced some updates to version 4 of the Name Manager.

Since I haven’t had any bug reports for about four weeks, I have decided it is about time to release this version.

Before I do so, I give you guys (and girls of course!) a last chance to report any issues to me.

So have a go at it, break it! If I get no new issues back, I’ll post the release in about one week.

Regards,

Jan Karel Pieterse
www.jkp-ads.com

Commercial use of SQL Server 2005 Express Edition?

Posted on by Anonymous

Hi all,

It seems that SQL Server 2005 Express Edition now can be used for commercial purposes. The following link to a recent post SQL Server Express EULA at MSDN Forums seems to confirm it and apparently it’s applicable from SP1 and forward.

With all the respect for MDBs (so called ‘Access-databases’) but this major change in the EULA will make it very interesting to replace present MDBs with SQL Server 2005 EE. What’s Your opinion about it?

Startpage: SQL Server 2005 Express Edition

Kind regards,
Dennis

SQL Query Builder

Posted on by Dick Kusleika

I’m back to my never ending quest to parse SQL statements. This time it’s in connection with my recent work with the Quickbooks SDK. More on that later, but for now I’m trying to take a simple WHERE clause and turn it into the XML that Quickbooks requires. I just don’t think I have it in me to parse every possible combination of fields, operators, values, and functions that could be in the WHERE clause. I was attempting to go back to the Microsoft SQLParser Object and stumbled upon TTG SQL Query Builder (TTGQuery.dll).

This dll apparently has something to do with the Great Plains Accounting Software Package, which I don’t have installed. Mine was found at C:Program FilesMicrosoft OfficeOFFICE11Business Contact ManagerIMTTGQuery.dll. I seem to remember installing the Business Contact Manager, but that could have just been a dream.

It doesn’t solve my parsing problem, but it was pretty interesting. The object model is pretty extensive. Here it is in it’s entirety:

Object Browser window showing ttgquery.dll

You give it a connection object and call a method, it gives you a UI for creating a query. Here’s my first hack at it:

Sub Testttg()
     
    Dim qb As QueryBuilder
    Dim cn As ADODB.Connection
    Dim sConn As String
    Dim sSql As String
   
    sConn = “DSN=MS Access Database;DBQ=C:Documents and SettingsDick.NEBRASKA”
    sConn = sConn & “My DocumentsNwind.mdb;DefaultDir=C:Documents and Settings”
    sConn = sConn & “Dick.NEBRASKAMy Documents;DriverId=281;”
    sConn = sConn & “FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;”
 
    Set qb = New QueryBuilder
   
    Set cn = New ADODB.Connection
   
    cn.Open sConn
   
    Set qb.ADOConnection = cn
    sSql = qb.GetSQLStatement(False)
   
    MsgBox sSql
   
End Sub

That gets me this

Query Builder dialog

The dialog returns a string (an empty string if you cancel) that I display in a message box. I can’t figure out what the argument to GetSQLStatement is. It’s labeled Cancel, but True and False give me the same result. As far as I can tell, you can create SQL strings, but not edit them. There appears to be no way to pass a SQL statement into the dialog.

message box showing sql statement

Excel & PDFCreator Take II

Posted on by Anonymous

Hi all,

Ale recently posted in a comment in Excel & PDFCreator where he informed about another free utility, pdftk tool and below is an example on how we can control it via VBA:

Option Explicit
‘ AleV 20060516

‘ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
‘ API CALLS: Wait for a Process to Terminate
‘ http://www.thescarms.com/vbasic/wait.asp
‘ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

Const SYNCHRONIZE = &H100000
Const INFINITE = &HFFFF
 ‘Wait forever
 Const WAIT_OBJECT_0 = 0
 ‘The state of the specified object is signaled
 Const WAIT_TIMEOUT = &H102
‘The time-out interval elapsed & the object’s state
‘is nonsignaled.

Private Declare Function OpenProcess Lib “kernel32” (ByVal dwDesiredAccess As Long, _
            ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long

Private Declare Function WaitForSingleObject Lib “kernel32” (ByVal hHandle As Long, _
            ByVal dwMilliseconds As Long) As Long

Private Declare Function CloseHandle Lib “kernel32” (ByVal hObject As Long) As Long

Sub mergePdf(PdfDir As String, outdir As String)
    ‘ PdfDir: where the single pdf files are saved
    ‘ outdir: output folder
    
   
    Dim cmdApp As String
       
    Dim lPid As Long, lHnd As Long, lRet As Long
    cmdApp = “C:inpdftkpdftk.exe “ & PdfDir & “*.pdf cat output “ & _
    outdir & “” & Format(Now(), “yyyymmddhhmmss”) & “_MERGED_REPORT.pdf”
    lPid = Shell(cmdApp, vbNormalFocus)
    If lPid <> 0 Then
        ‘Get a handle to the shelled process.
        lHnd = OpenProcess(SYNCHRONIZE, 0, lPid)
        ‘If successful, wait for the application to end and close the handle.
        If lHnd <> 0 Then
                lRet = WaitForSingleObject(lHnd, INFINITE)
                CloseHandle (lHnd)
        End If
End If

End Sub

Sub ExampleMergePDF()
    With ThisWorkbook.Worksheets(“cp”)
        mergePdf .Range(“PDFdir”).Value, .Range(“outdir”).Value
    End With
    MsgBox “done!”
End Sub

I hope that there soon will be a solution to allow code examples to be posted in the comments without being corrupted.

Anyway, thanks for the input :)

Kind regards,
Dennis

Add and remove shortcuts in the Open & Save As dialogs

Posted on by Anonymous

Add and remove shortcuts in the Open & Save As dialogs

Creating and removing customized shortcuts can either be done manually or via code. When we make any change(s) it will affect all Office programs.

Manually
If we want to do it manually we need to open the Regeditor and locate the following key in Windows registry:

HKEY_CURRENT_USERSoftwareMicrosoftOfficeVersionnumberCommonOpen FindPlacesUserDefinedPlaces

The ‘Versionnumber’ refers to 9.0, 10.0, 11.0 and later.

– Under this key we create a new subkey and name it (for instance Daily Dose)
– For the new subkey we add two string values:
‘Name’ and with the value for the name to be showed in the dialogs (for instance Daily Dose)
‘Path’ and with the value of the pathway to be available in the dialogs (for instance c:Daily Dose)

The following image shows the settings in the registry:


(The screenshot is from my Swedish Windows XP)

Another important subkey is ‘Places’ which contain the string value ‘ItemSize’. It control if the shortcuts will be showed as compressed (value 0) or not (value 1). If we have many shortcuts it can be suitable to ‘compact’ them in the dialogs. The ‘ItemSize’ can be located at the following place in Windows registry:

HKEY_CURRENT_USERSoftwareMicrosoftOfficeVersionnumberCommonOpen FindPlaces

Via code
The below solutions use the RegObj.dll and for more information about Regobj please see Add-ins – Working with Windows registry

Option Explicit
Option Private Module

‘A reference to the Registration Manipulation Classes must be set.

Dim m_regRootKey As RegKey
Dim m_regMainKey As RegKey
Dim m_stSubRoot As String
Dim m_stSubPlace As String

Sub Add_ShortCut_Office()
If Add_ShortCut(“11.0”, “XL-Dennis”, “My storage”, “c:XL-Dennis”, 0) Then
    MsgBox “The shortcut has successfully been added to the list.”, vbInformation
Else
    MsgBox “The shortcut already exist in Windows Registry.”, vbInformation
End If
End Sub

Sub Remove_ShortCut_Office()
If Remove_ShortCut(“11.0”, “XL-Dennis”, 1) Then
    MsgBox “The shortcut has successfully been removed.”, vbInformation
Else
    MsgBox “The shortcut does not exist in Windows Registry.”, vbInformation
End If
End Sub

Function Add_ShortCut(ByVal stXLVersion, _
                                                   ByVal stMainKey As String, _
                                                   ByVal stName As String, _
                                                   ByVal stPath As String, _
                                                   ByVal lnSize As Long) As Boolean

On Error GoTo Error_Handling

‘Registry path to set the size of the shortcuts in the dialogs.
m_stSubPlace = “SoftwareMicrosoftOffice” & stXLVersion & _
                                  “CommonOpen FindPlaces”

‘Registry path to add user defined places.
m_stSubRoot = “SoftwareMicrosoftOffice” & stXLVersion & _
                                 “CommonOpen FindPlacesUserDefinedPlaces”

‘Set the rootkey.
Set m_regRootKey = RegKeyFromHKey(HKEY_CURRENT_USER)

‘Parse the subkey.
Set m_regMainKey = m_regRootKey.ParseKeyName(m_stSubRoot)

With m_regMainKey
    .SubKeys.Add stMainKey ‘Create the subkey.
    With .SubKeys(stMainKey)
        ‘Add the shortcuts which are string values.
        .Values.Add “Name”, stName, RegValueType.rvString
        .Values.Add “Path”, stPath, RegValueType.rvString
    End With
End With

‘Parse the subkey.
Set m_regMainKey = m_regRootKey.ParseKeyName(m_stSubPlace)

‘It seems that there only exist two workable values, 0 and 1
‘where 0 represent the compacted status and 1 the standard.
If lnSize > 1 Then
    lnSize = 1
ElseIf lnSize < 0 Then
    lnSize = 0
End If

If m_regMainKey.Values(“ItemSize”).Value <> lnSize Then
    m_regMainKey.Values(“ItemSize”).Value = lnSize
End If

Add_ShortCut = True

ExitHere:
‘Release objects from memory.
Set m_regRootKey = Nothing
Set m_regMainKey = Nothing
Exit Function

Error_Handling:
    ‘Error 35004 indicates that the shortcut entry already exist.
    If Err.Number = 35004 Then Add_ShortCut = False
    Resume ExitHere
End Function

Function Remove_ShortCut(ByVal stXLVersion, _
                                                           ByVal stMainKey As String, _
                                                           ByVal lnSize As Long) As Boolean

On Error GoTo Error_Handling

m_stSubPlace = “SoftwareMicrosoftOffice” & stXLVersion & _
                                  “CommonOpen FindPlaces”

m_stSubRoot = “SoftwareMicrosoftOffice” & stXLVersion & _
                                 “CommonOpen FindPlacesUserDefinedPlaces”

Set m_regRootKey = RegKeyFromHKey(HKEY_CURRENT_USER)

Set m_regMainKey = m_regRootKey.ParseKeyName(m_stSubRoot)

m_regMainKey.SubKeys.Remove stMainKey

Set m_regMainKey = m_regRootKey.ParseKeyName(m_stSubPlace)

If lnSize > 1 Then
    lnSize = 1
ElseIf lnSize < 0 Then
    lnSize = 0
End If

If m_regMainKey.Values(“ItemSize”).Value <> lnSize Then
    m_regMainKey.Values(“ItemSize”).Value = lnSize
End If

Remove_ShortCut = True
   
ExitHere:
Set m_regRootKey = Nothing
Set m_regMainKey = Nothing
Exit Function

Error_Handling:
    ‘Error 35006 indicates that the shortcut entry does not exist.
    If Err.Number = 35006 Then Remove_ShortCut = False
    Resume ExitHere
End Function

The following picture shows the Open Dialog when we have added a shortcut (via the above code) and also have compressed the list:

Shortcuts

For privacy I have removed all info in the dialog

The above is applicable for Excel 2000 and later.

Kind regards,
Dennis

Important: Whenever You are working with the Windows registry make sure You first make a backup of the registry.

Mpemba Speech Code

Posted on by Dick Kusleika

I don’t know why code is rendered so poorly in the comments of this blog. I wish I had the smarts to modify iGSyntax Hiliter to work in the comments section, but I don’t. Here’s the code that Mpemba posted in a comment to John’s Speech post. You should be able to copy it from here and paste it into the VBE without issue. Don’t forget to set a reference to Microsoft Speech Library (Tools > References).

Sub Test()
    SaySomething “Hello”, “Him”, 10, 100
    SaySomething “Hello”, “Her”, 10, 100
    SaySomething “Hello”, “None”, -5, 100
End Sub
 
Sub SaySomething(Words As String, Person As String, Rate As Long, Volume As Long)
    Dim Voc As SpeechLib.SpVoice
    Set Voc = New SpVoice
   
    With Voc
        Debug.Print .GetVoices.Count
   
        If Person = “Him” Then
            Set .voice = .GetVoices.Item(0) ‘LH Michael
        ElseIf Person = “Her” Then
            Set .voice = .GetVoices.Item(1) ‘LH Michelle
        Else
            Set .voice = .GetVoices.Item(2) ‘Microsoft Sam
        End If
        .Rate = Rate
        .Volume = Volume
        .Speak Words
    End With
End Sub