Option Explicit
Private myMdbPath As String
Private myMDB As Database
Private myTableDef As TableDef
Private myIndex As DAO.Index

Sub Create_MDB()
    myMdbPath = ThisWorkbook.Path & "\" & _
                                myMDBName & ".mdb"
    If Dir(myMdbPath)  "" Then Kill myMdbPath

    Set myMDB = CreateDatabase(myMdbPath, dbLangGeneral)

    Set myTableDef = myMDB.CreateTableDef(MyTable)

    With myTableDef
        .Fields.Append .CreateField("ID", dbLong, 4)
        .Fields.Append .CreateField("ACCT", dbText, 14)
   .Fields.Append .CreateField("CII", dbText, 14)
   .Fields.Append .CreateField("STATUS", dbText)
   .Fields.Append .CreateField("DECISION", dbText)
   .Fields.Append .CreateField("RACF", dbText)
   .Fields.Append .CreateField("CONTRACTDATE", dbDate)
   .Fields.Append .CreateField("RECEIPTDATE", dbDate)
   .Fields.Append .CreateField("FOLLOWUPDATE", dbDate)
   .Fields.Append .CreateField("FOLLOWUP_N1", dbText)
   .Fields.Append .CreateField("FOLLOWUP_N2", dbText)
   .Fields.Append .CreateField("DECLIFE", dbText)
   .Fields.Append .CreateField("DECDIS", dbText)
   .Fields.Append .CreateField("REASON", dbText)
   .Fields.Append .CreateField("FIRSTNAME", dbText)
   .Fields.Append .CreateField("LASTNAME", dbText)
   .Fields.Append .CreateField("ADDLINE1", dbText)
   .Fields.Append .CreateField("ADDLINE2", dbText)
   .Fields.Append .CreateField("CITY", dbText)
   .Fields.Append .CreateField("ST", dbText, 2)
   .Fields.Append .CreateField("ZIP", dbText, 5)

   myTableDef("ID").Attributes = dbAutoIncrField

   Set myIndex = .CreateIndex("ACCT")
   myIndex.Fields.Append myIndex.CreateField("ID", dbLong)

        myIndex.Primary = True
        .Indexes.Append myIndex
    End With

    ' Save Table info
    myMDB.TableDefs.Append myTableDef
    myMDB.Close
End Sub

Private Function myMDBName()
myMDBName = Application.InputBox("Give " &amp: _
     the name of the " & _
     "Access file you want to be saved. ")
End Function
Private Function MyTable()
    MyTable = Application.InputBox("Give " & _
     the name of the " & _
     "Table you want in MDB file. ")
End Function

For more on Resources, Downloads, &
Tutorials visit following pages
http://selvavinaygam.googlepages.com
http://socko.350.com

For Feedback and/or comments, please mail me at
s o c k o (at) r e d i f f m a i l (dot) c o m

For some reason best known to Microsoft, the Excel documentation does not include a graphic list of shapes with an example of each shape, and the text list they do provide is incomplete. 

The file shapelist.zip

rectifies that omission with an automatically generated table of shapes from number 1 through to 183.

It also includes examples of how arcs (shape no. 25) work in Excel 2007 and earlier versions.
 

The size and position of arcs are defined with the usual width, height, left, and top properties, but note that the width and height are equal to the arc radius, and the left coordinate is equal to the X value of the arc centre.  The start and end points of the arc are defined with Adjustment(1) and Adjustment(2), and the shape thus defined may be rotated with the Rotation property.  Unfortunately there are significant differences in the way in which these properties are applied in Excel 2007 and earlier versions.

Assuming  an XY coordinate system, with origin at the centre of the arc:

Adjustment(1)  defines the angle of the start of the arc, measured from the X axis.  In Excel 2007 clockwise angles are positive, in earlier versions anti-clockwise is positive.

In both versions an Adjustment(1) value of zero defaults to a starting point on the Y axis, i.e. to -90 degrees in Excel 2007 and 90 degrees in earlier versions.

Adjustment(2) defines the angle of the end of the arc, measured from the X axis, with the same sign convention as adjustment(1).  An adjustment(2) value of zero defines an end point on the X axis, as would be expected, zero values for both adjustments therefore defines an arc between the Y and X axes.

The rotate property rotates the defined shape, with a clockwise rotation being positive in all Excel versions.

In Excel 2007 the shape is rotated about the origin, i.e. the centre of curvature of the arc.  In earlier versions the rotation appears to be about the mid-point of a radial line to the centre of the arc.

For compatibility between versions it seems best to avoid using the Rotation property, and adjust the sign of the adjustment angles according to the version number.

Code to generate an arc and a circle, using values specified in a spreadsheet range, is shown below.  The code checks for the Excel version, and for versions earlier than 2007 (version 12.0) reverses the sign of the arc adjustments, so that the arcs drawn are consistent across versions.

Sub Drawshape()

End Sub
 
An example of the shapes generated by this code is shown below:

Note that "Width" and "Height" values of the circle are double that of the arc, and the "Left" value of the circle is 105 less than that of the arc.

Use of the "rotation" property in Excel 2007 and earlier versions is illustrated below:

Note that the input for these two screen shots was identical.

  vbFirst = 0

  vbLast = 1

Public Function ParseName(fullname As String, type As ExtractType) As String

  pos = InStrRev(fullname, " ")

  If type = vbFirst Then

    ParseName = Right(fullname, Len(fullname) - pos)

  Else

    If type = vbLast Then

      ParseName = Trim(Left(fullname, pos))

    End If

  End If

End Function

I have added a Newton's Cradle animation to the animation file posted previously:

Animation.zip

The animation finds the correct period for the input string length and starting angle, and displays the movement of the balls in real time.

This code will check my inbox every time I start outlook for emails older than 7 days.
If found it will place emails from corporate collegues into one rootfolder named after
my company. Then it will create a subfolder with the senders name (if not allready existing)
and put the older email in that folder. So I have all mails sorted
in their own maps by user. All external mails are placed in another rootfolder
called "extern" and then subfolders are created based on senders domain name.

How to install:
1. Make 2 subfolders in your inbox (eg. MyCompany, External)
2. Open Visual Basic Editor (ALT+F11)
3. In the project explorer, expand "Microsoft Office Outlook Project" and doubleclick
"ThisOutlookSession" to edit it's code.
4. Copy and paste the code below and change the 4 variables:
- strCompany = the folder you created in your inbox for corporate emails.
- strExternaly = the folder you created in your inbox for external emails.
- intAge = the age a mail should be before moving it (in days).
- strDSN = general DSN for your company. Change "COMPANY".
(if you don't know what DSN is, ask your system administrator)
5. Save and quit.
6. Start Outlook, have some patience and see how
every mail older then (in this case) 7 days is nicely organized!

Dim x, i As Integer

Private Sub Application_Startup()
On Error Resume Next

    Dim intDays As Integer
    Dim strCompany, strExternaly, strDSN As String
    'MODIFY HERE:
    strCompany = "Aliplast"
    strExternaly = "Extern"
    strDSN = "/O=ALIPLAST/OU=FIRST ADMINISTRATIVE GROUP/CN=RECIPIENTS/CN="
    intAge = 7

    Dim strID As String
    Dim objNS As Outlook.NameSpace
   
    Dim m As Outlook.MailItem
    Dim oInboxItem As Outlook.MailItem
   
    Dim fInbox As MAPIFolder
    Dim fCompany As MAPIFolder
    Dim fExtern As MAPIFolder
    Dim fFolder As MAPIFolder
   
    Set objNS = Application.GetNamespace("MAPI")
    Set fInbox = objNS.GetDefaultFolder(olFolderInbox)
    Set fCompany = fInbox.Folders(strCompany)
    Set fExtern = fInbox.Folders(strExternaly)
   
    'm.UserProperties
    For Each oInboxItem In fInbox.Items
        strID = oInboxItem.EntryID
        If strID = "" Then
            ' MsgBox strID
        Else
            Set m = objNS.GetItemFromID(strID)
            ' MsgBox m.ReceivedTime < vbCrLf & Now() - intAge
            If m.ReceivedTime < Now() - intAge Then
                If InStr(m.SenderEmailAddress, "/" & StripDSN(strDSN)) Or InStr(m.SenderEmailAddress, "aliplast") Then
                    ' Exchange mail
                    ' MsgBox m.SenderEmailAddress
                    fFolder = fAliplast.Folders(Exchange(m.SenderEmailAddress))
                    fAliplast.Folders.Add (Exchange(m.SenderEmailAddress))
                    m.Move fAliplast.Folders(Exchange(m.SenderEmailAddress))
                Else
                    ' Externe mail
                    ' MsgBox Domein(m.SenderEmailAddress)
                    fFolder = fExtern.Folders(Domein(m.SenderEmailAddress))
                    fExtern.Folders.Add (Domein(m.SenderEmailAddress))
                    m.Move fExtern.Folders(Domein(m.SenderEmailAddress))
                End If
            End If
        End If
    Next

    Set m = Nothing
    Set objNS = Nothing
End Sub

Public Function Domein(email As String) As String
x = 1
Do
x = x + 1
Loop Until Mid(email, x, 1) = "@"
Domein = Mid(email, x + 1, (Len(email) - x) + 1)
End Function

Public Function Exchange(email As String) As String
Exchange = StrConv(Replace(Replace(email, strDSN, ""), ".", " "), vbProperCase)
End Function

Public Function StripDSN(DSN As String) As String
Dim tmp As String
tmp = ""
x = 1
i = 0
Do
If Mid(DSN, x, 1) = "/" Then
x = x + 1
i = i + 1
Else
tmp = tmp & Mid(DSN, x, 1)
x = x + 1
End If
Loop Until Mid(DSN, x, 1) = "/"
StripDSN = tmp
End Function 

For each of the shapes in the example code the shape was added to the "shape collection" (and hence displayed on the active worksheet) with a command of the form, either:

set VariableName = ActiveSheet.Shapes.addShape(parameters)

or

with ActiveSheet.Shapes.addShape(parameters)
.property = PropertySetting
end with

or the similar:

ActiveSheet.Shapes.addShape(parameters).property = PropertySetting

For two of the methods used in the example (AddCurve and AddPolyLine) a different form is allowed; e.g.:

ActiveSheet.Shapes.AddCurve (PointArray)

will add the curve specified by PointArray to the shapes collection.  Note the space between AddCurve and the parameters.  The editor will add the space if necessary for those methods where this form is acceptable, otherwise it will tell you that it is expecting a "=", and one of the forms described earlier must be used.

I have no idea what is the logic (or if there is any logic) behind the way the different methods are handled, but it seems to me best to stick with command forms that will work for all the shape methods.

It can be seen that there are a variety of methods to create simple shapes, for instance a straight line can be created using:

AddLine
AddPolyline (with one segment)
AddShape
ConverttoShape
or even AddCurve

Similarly the dodecahedron can be created with AddPolyline, ConverttoShape or AddShape, but using AddCurve with the same coordinates produces a different shape.

In general I will be using AddLine or AddPolyLine in most cases, with AddShape being used for arcs and circles (or ellipses) or if a regular polygon is required.

The final point concerns the naming of shapes.  Each of the shapes except the dodoecahedron created with the AddPolyline method have been given a name at the time of their creation.  Shapes not explicitly named are given a name consisting of a description followed by a sequence number, such as FreeForm44.  Since the sequence number will increment as shapes are created and deleted it is impossible to know what any given shapes allocated name will be, so if you will need to select a shape using VBA code at any time the shape should be named explicitly at the time of its creation.

Then I remembered that VBA is based on the Microsoft Visual Basic 6 IDE which doesn't include built-in support for the scroll wheel.

After a little searching I found the following article on the Microsoft site: http://office.microsoft.com/en-us/access/HA101175901033.aspx (opens in new window)

In short, to enable the mouse wheel scrolling behaviour in the VBA window, you must download a package from Microsoft at http://office.microsoft.com/search/redir.aspx?AssetID=XT101665991033&CTT=5&Origin=HA101175901033 (opens in new window) and then do the following:

• Run the downloaded executable to extract the files
• Add the included DLL to your machine
• Register the DLL using RegSvr32
• Run the included registry file to add the required elements to your machine's registry (remembering to take a backup of the registry first of course)
• Add the MouseWheel Fix to your VBA project using the Add-In manager

Now the scroll wheel should work in your VBA code!

For example:

Dim varMyValue as Variant
varMyValue = NULL
MsgBox IsNull(varMyValue + 2)


This will return TRUE.

However, it is often the case that we would like this expression to "ignore" the NULL value and return the value 2.

We can achieve this using the NZ function.

The syntax of this function is as follow:

Nz(variant, [valueifnull])

Thus we could ignore the NULL value and substitute it with 0.

e.g.

Dim varMyValue as Variant
varMyValue = NULL
MsgBox NZ(varMyValue,0) + 2


Here the NULL value is replaced with the value zero and our message box displays the value 2.

We could also use the NZ function in other ways.

If we have a variable containing a string , for example, the country of a purchaser (e.g. UK, US, PL) and we use this to calculate a postage rate for goods sent to this purchase we could use the NZ function in the following way to replace a NULL value with a suitable message or calculation.

e.g.

strPostage = NZ(strCountry,0) ' if we wanted to set the postage value to zero if it is NULL


or

strPostage = NZ(strCountry,"No Country Code Given") ' to maybe use in a MsgBox if strCountry is NULL


We could also use the NZ function in an Access SQL query.


SELECT [Surname], [FirstName], [DOB], NZ([Address],"No Address Available")


Note, however, that this function is only available within Access and not within any of the rest of the Office suite. Also, other variants of SQL may not support this function.

So, in other words, if red is RGB(250,0,0), yellow is RGB(250,250,0), and green is RGB(0,250,0), how do we gradually go from red to green depending on how far away from budget we are? By the way, for those who don't know, the RGB number format is simply three numbers from 0 to 250 that represent how much of each color red, green, and blue the computer ought to use to compose a color. Adding red light to green light makes yellow light, so RGB(250,250,0) means you want to use pure red and pure green, but no blue in order to get yellow.

My first task was deciding how to measure the distance from budget. After a lot of calculations, I realized it should simply be how far from 100% of the budget we were. That leaves a scale of 0 to 100. At 100, we want to just display green, and at 0 we want red.

My second task was fading from red to green by going through yellow. My best solution was to split the task in half. If the actual value was less than 50% of the goal, we would worry about fading from red to yellow (we would only need to mess with the green color). If the actual value was more than 50%, we would fade from yellow to green (only mess with the red color). In other words: If 50% of budget, green = 250, red = calculated value. Blue is always 0.

Since there are 250 steps of color in the RGB scale, but only 125 for each half (red to yellow, yellow to green), then for every percent of budget, we want to add or remove 5 steps of color.

That's all I need to explain, I think, in order to remember this later. If you have any questions, I will gladly answer them. What follows are two real-world examples taken straight from my current project.

Sub looper()

End Sub