So I had a problem where something was not working in a staging environment but fine in dev. So I wanted to compare about 300 tables in a database to a different copy of it to see if a table was empty somewhere that was causing the error. Still haven't found the error yet. Also, the reason I'm doing so is because I'm working with a proprietary API library that manages to obfuscate which tables are being called.
To get the list of empty tables, we can use the below tsql –
EXEC sp_MSforeachtable 'IF NOT EXISTS (SELECT 1 FROM ?) PRINT ''?'' '
And, to get a list of tables having at least one row of data, we can use the below tsql –
EXEC sp_MSforeachtable 'IF EXISTS (SELECT 1 FROM ?) PRINT ''?'' '
Major thanks to
8c0b7683-9c25-48c9-97a4-9460c01f3dea|0|.0
I was given a task of converting some aging reports to SSRS. Now as you know, you can't really do grouping in SQL based on a range. So something like that needs to be implemented in SSRS in the report writter instead. I have figured out that code for you. :)
First we need to copy this code into the report. From the report properties the first box will be for adhoc vb functions to add to the report. In general these functions should be added to a class and linked, either way this is the function you need.
Public Function GetBucket(parameter As parameter, days As Integer) As String
On Error GoTo ProcError
Dim s As String
Dim i As Integer
s = ""
If parameter.IsMultiValue Then
For i = 0 To parameter.Count - 2
If (parameter.Value(i) < days and parameter.Value(i+1) > days) Then
GetBucket = Str(parameter.Value(i)) + " -" + Str(parameter.Value(i+1))
Exit Function
End If
Next
End If
GetBucket = parameter.Value(parameter.Count - 1) + "+"
Exit Function
ProcError:
GetBucket = Err.Description
End Function
After that, we will define a calculate field in our dataset.
=Code.GetBucket(Parameters!Bucket,DateDiff("d",Fields!DateToAgeOn.Value,Today()))
Then set up a parameter, type integer, and allow mulitple values. Then we can just set some default values for our ranges.
f625da41-24fa-4a10-b0f2-bdc145f58d69|1|3.0
Here is macro code for outlook to save all attachments of all selected email. It will prompt for a save directory and allow renaming of duplicate files. This just saved me probably a full day at work of saving all files since Outlook does not have this feature built in. Special thanks to Arcane Code
Option Explicit
Public Sub SaveAttachments()
'Note, this assumes you are in the a folder with e-mail messages when you run it.
'It does not have to be the inbox, simply any folder with e-mail messages
Dim App As New Outlook.Application
Dim Exp As Outlook.Explorer
Dim Sel As Outlook.Selection
Dim AttachmentCnt As Integer
Dim AttTotal As Integer
Dim MsgTotal As Integer
Dim outputDir As String
Dim outputFile As String
Dim fileExists As Boolean
Dim cnt As Integer
'Requires reference to Microsoft Scripting Runtime (SCRRUN.DLL)
Dim fso As FileSystemObject
Set Exp = App.ActiveExplorer
Set Sel = Exp.Selection
Set fso = New FileSystemObject
outputDir = GetOutputDirectory()
If outputDir = "" Then
MsgBox "You must pick an directory to save your files to. Exiting SaveAttachments.", vbCritical, "SaveAttachments"
Exit Sub
End If
'Loop thru each selected item in the inbox
For cnt = 1 To Sel.Count
'If the e-mail has attachments...
If Sel.Item(cnt).Attachments.Count > 0 Then
MsgTotal = MsgTotal + 1
'For each attachment on the message...
For AttachmentCnt = 1 To Sel.Item(cnt).Attachments.Count
'Get the attachment
Dim att As Attachment
Set att = Sel.Item(cnt).Attachments.Item(AttachmentCnt)
outputFile = att.fileName
fileExists = fso.fileExists(outputDir + outputFile)
Do While fileExists = True
outputFile = InputBox("The file " + outputFile _
+ " already exists in the destination directory of " _
+ outputDir + ". Please enter a new name, or hit cancel to skip this one file.", "File Exists", outputFile)
'If user hit cancel
If outputFile = "" Then
'Exit leaving fileexists true. That will be a flag not to write the file
Exit Do
End If
fileExists = fso.fileExists(outputDir + outputFile)
Loop
'Save it to disk if the file does not exist
If fileExists = False Then
att.SaveAsFile (outputDir + outputFile)
AttTotal = AttTotal + 1
End If
Next
End If
Next
'Clean up
Set Sel = Nothing
Set Exp = Nothing
Set App = Nothing
Set fso = Nothing
'Let user know we are done
Dim doneMsg As String
doneMsg = "Completed saving " + Format$(AttTotal, "#,0") + " attachments in " + Format$(MsgTotal, "#,0") + " Messages."
MsgBox doneMsg, vbOKOnly, "Save Attachments"
Exit Sub
ErrorHandler:
Dim errMsg As String
errMsg = "An error has occurred. Error " + Err.Number + " " + Err.Description
Dim errResult As VbMsgBoxResult
errResult = MsgBox(errMsg, vbAbortRetryIgnore, "Error in Save Attachments")
Select Case errResult
Case vbAbort
Exit Sub
Case vbRetry
Resume
Case vbIgnore
Resume Next
End Select
End Sub
Public Function GetOutputDirectory() As String
Dim retval As String 'Return Value
Dim sMsg As String
Dim cBits As Integer
Dim xRoot As Integer
Dim oShell As Object
Set oShell = CreateObject("shell.application")
sMsg = "Select a Folder To Output The Attachments To"
cBits = 1
xRoot = 17
On Error Resume Next
Dim oBFF
Set oBFF = oShell.BrowseForFolder(0, sMsg, cBits, xRoot)
If Err Then
Err.Clear
GetOutputDirectory = ""
Exit Function
End If
On Error GoTo 0
If Not IsObject(oBFF) Then
GetOutputDirectory = ""
Exit Function
End If
If Not (LCase(Left(Trim(TypeName(oBFF)), 6)) = "folder") Then
retval = ""
Else
retval = oBFF.self.Path
'Make sure there's a \ on the end
If Right(retval, 1) <> "\" Then
retval = retval + "\"
End If
End If
GetOutputDirectory = retval
End Function
41c9470b-e4b3-4ddf-9e96-a4d204049164|0|.0
Randomly got this on the new Digg page. Hilarious!

d57b4870-30d8-4deb-97de-d7e4069eda8d|0|.0
Let me start off by apologizing for the older themes. I'm still new to CSS and web design. I had put a little bit of code at the top of all the old CSS files to reset margins and padding on all the elements. After research, I've determind that was a bad idea. I've removed it from all the themes and made adjustments to a few classes to keep layout the same. I did only a quick spot check though, so I may have missed something.
If you have an old theme, I strongly recommend you update it. Or if you notice anything really wierd, let me know and I will be glad to help in my free time.
Thanks
ff35a507-d7c3-4d43-969d-0cce9196d0c4|0|.0
Good news everybody, I'm releasing a modified version of an older theme. It has a little bit of CSS3 in it, but nothing to serious. It will still look fine on Internet Explorer if you're unfortunate enough to still be running it. I did however move some things around and changed up the comment layout for this one. There is also a special surprise for administators!
Preview | Download
0d6ee625-5648-4f3a-ab83-b828020d989e|1|5.0
767643f4-14f8-40d8-9b68-009aec915446|0|.0
Blog Engine was updated to v1.6 last night. This morning I made the CSS changes and a few edits to all the themes. All the downloads how now been updated to v1.6 and removed the 1.5 versions.
914fb998-46cf-44ed-aa2d-b87782809bd2|0|.0
Hey everyone, it's a new year and that means it's time to crank out some more themes. I'm going to start categorizing these themes a little better. Eventually I still want to do more with this site, but this is easier since I'm doing it partially for work anyways. Enjoy!
Preview | Download
9cf84ae0-c8e6-4bfe-ba56-d502060d5a8a|0|.0
Hey everyone. In keep with my random release schedule, here is another theme. I tried to keep this one to a more minimal look. Again, I'm bad at naming these things. So I just called it SimpleGrey. It's modified/ported from themeforest.com link
Preview | Download
598904f1-5e41-4f81-b1f6-234e0e325811|1|4.0