Restructuring code in two .bat files - csv

I have developed a program (1) coded in batch named info.bat:
Store information about a computer,
Manipulates information and outputs details to %ComputerName%.csv file.
Then a .vbs file (2) is called, and this outputs a list of installed programs to %ComputerName%-programs.txt file in the same directory as the .csv file.
The batch file ends when the .vbs has finished, and user is shown a Cmd window ready for next command.
Next another program StripSoftware.bat (3) is manually started:
It creates %ComputerName%-programs-to-check.txt,
Adds OS version and %ComputerName%,
Examines entries in %ComputerName%-programs.txt,
Takes out unwanted matches (using findstr and switches),
Removes empty lines,
Sorts results ascending,
Then puts them into %ComputerName%-programs-to-check.txt
Aim:
I need to use the software entries (1 line per software name) in %ComputerName%-programs-to-check.txt, concatenate them together, then put them into the software_needed column in the .csv file.
Output:
The output needed is a .csv file or preferably an .xlsx file with the following headers in the 1st row, and applicable information in the 2nd row.
.csv example:
v34,ID,Asset,Sys_Type,Model,NHC Asset,New Sys Type,New Model,New Sys Asset,Domain,DIR,Site,Team,Location,Post,Name,Postcode,Local Printers,Network Printers,Eth_MACs,Wifi_MACs,Phone_MAC,Software Needed,OTHER_ASSET,OS_VER,Hostname,Software_Notes,Other_Notes,IGEL_REC
,,ABCDEFG,PC,A123,,,,,XXXX,Unknown,,,,,,, , ,||"XX-XX-XX-XX-XX-XX"|"Disabled",,,Not Used,ABCDEFG,Win XP Pro,ABCDEFG,,,
Partial contents of info.bat:
#echo OFF
setlocal enableextensions enabledelayedexpansion
SET file="%~dp0%computername%.csv"
If Exist %file% Del %file%
echo %Version_tool%,ID,Asset,Sys_Type,Model,NHC Asset,New Sys Type,New Model,New Sys Asset,Domain,DIR,Site,Team,Location,Post,Name,Postcode,Local Printers,Network Printers,Eth_MACs,Wifi_MACs,Phone_MAC,Software Needed,OTHER_ASSET,OS_VER,Hostname,Software_Notes,Other_Notes,IGEL_REC>>%file%
rem ========= Other code =========
echo ,%ID%,%serialnumber%,PC,%model%,,,,,%userdomain%,Unknown,,,,,,,%Local_Printers%,!network_printers!,!Eth_MACs!,!Wifi_MACs!,!Phone_MACs!,Not Used,%system%,%osname%,%Hostname%,,,%IGEL REC%>> %file%
SET file2="%~dp0%computername%-programs.txt"
If Exist %file2% Del %file2%
start /b cmd /k "cscript //nologo programs_02.vbs >> %file2%"
echo Batch Tool should finish in a few seconds ...
Contents of .vbs file:
Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
strComputer = "."
strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
strEntry1a = "DisplayName"
strEntry1b = "QuietDisplayName"
strEntry2 = "InstallDate"
strEntry3 = "VersionMajor"
strEntry4 = "VersionMinor"
strEntry5 = "EstimatedSize"
Set objReg = GetObject("winmgmts://" & strComputer & "/root/default:StdRegProv")
objReg.EnumKey HKLM, strKey, arrSubkeys
WScript.Echo "Installed Applications" & VbCrLf
For Each strSubkey In arrSubkeys
intRet1 = objReg.GetStringValue(HKLM, strKey & strSubkey, strEntry1a, strValue1)
If intRet1 <> 0 Then
objReg.GetStringValue HKLM, strKey & strSubkey, strEntry1b, strValue1
End If
If strValue1 <> "" Then
WScript.Echo VbCrLf & strValue1
End If
objReg.GetStringValue HKLM, strKey & strSubkey, strEntry2, strValue2
If strValue2 <> "" Then
'WScript.Echo "Install Date: " & strValue2
End If
objReg.GetDWORDValue HKLM, strKey & strSubkey, strEntry3, intValue3
objReg.GetDWORDValue HKLM, strKey & strSubkey, strEntry4, intValue4
If intValue3 <> "" Then
WScript.Echo "Version: " & intValue3 & "." & intValue4
End If
objReg.GetDWORDValue HKLM, strKey & strSubkey, strEntry5, intValue5
If intValue5 <> "" Then
'WScript.Echo "Estimated Size: " & Round(intValue5/1024, 3) & " megabytes"
End If
Next
Problem:
With current way the code is structured info.bat creates .csv file before the .txt files are created and values for Software_Needed (eg Adobe Flash | Hotfix for Windows) is available in %ComputerName%-programs-to-check.txt. Hence difficult to then update the .csv with the value for Software_Needed on the second row.
Proposed solution: (*)
I'm beginning to think the .vbs file should be called first to create %ComputerName%-programs.txt in the first .bat file, then in a second .bat file have the functionality in StripSoftware.bat to create %ComputerName%-programs-to-check.txt, and then use that and other information to create %ComputerName%.csv
Questions:
1) Would appreciate peoples thoughts, comments and views on the Proposed Solution
2) Suggestions as to better solutions than the proposed Solution.

It's unclear what you want. This is a standard post of mine. Then I'll show you something.
Start - All Programs - Accessories - Right click Command Prompt and choose Run As Administrator. Type (or copy and paste by right clicking in the Command Prompt window and choosing Paste). Type for table format
wmic /output:"%userprofile%\desktop\WindowsInstaller.html" product get /format:htable
or in a form format
wmic /output:"%userprofile%\desktop\WindowsInstaller.html" product get /format:hform
It will create a html file on the desktop.
Note
This is not a full list. This is only products installed with Windows Installer. There is no feature for everything.
However as I said in my previous post nearly everything is listed in the registry.
So to see it in a command prompt
reg query HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall /s
or in a file
reg query HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall /s>"%userprofile%\desktop\WindowsUninstall.txt"
To see it in notepad in a different format
Click Start - All Programs - Accessories - Right click Command Prompt and choose Run As Administrator. Type Regedit and navigate to
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall
Right click the Uninstall key and choose Export. If you save as a reg file (there is also text file, they are slightly different text formats) you need to right click the file and choose Edit to view it.
To view Windows Updates
wmic /output:"%userprofile%\desktop\WindowsUpdate.html" qfe get /format:htable
Here is a VBS script that get installed programs, sorts, and filters.
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set rs = CreateObject("ADODB.Recordset")
Set wshshell = CreateObject("wscript.shell")
Set Outp = Wscript.Stdout
ComputerName=WshShell.ExpandEnvironmentStrings("%Computername%")
'Build database with Computername and Softwarename
With rs
.Fields.Append "ComputerName", 201, 5000
.Fields.Append "Txt", 201, 5000
.Open
'Get list installed programs
Set colItems = objWMIService.ExecQuery("Select * From Win32_Product")
'Add to database
For Each objItem in colItems
.AddNew
.Fields("ComputerName").value = ComputerName
.Fields("Txt").value = objItem.Name
.UpDate
Next
'Sort Database on software name
'Sort and filter it - Softwarename acending (Txt) and filter only those starting M
.Sort = "Txt ASC"
.Filter = "Txt like 'm*'"
'write out to a CSV
Do While not .EOF
Outp.writeline .Fields("ComputerName").Value & "," & .Fields("Txt").Value
.MoveNext
Loop
End With
To use
cscript //nologo <path to vbs file> > OUTPUTFILE
This is the output
SERENITY,Microsoft .NET Framework 1.1
SERENITY,Microsoft .NET Framework 3.5 SP1
SERENITY,Microsoft .NET Framework 4 Client Profile
SERENITY,Microsoft .NET Framework 4 Extended
SERENITY,Microsoft Application Compatibility Toolkit 5.0
SERENITY,Microsoft Application Error Reporting
SERENITY,Microsoft Calculator Plus
SERENITY,Microsoft Device Emulator version 3.0 - ENU
SERENITY,Microsoft Document Explorer 2005
SERENITY,Microsoft Filter Pack 1.0
SERENITY,Microsoft LifeCam
SERENITY,Microsoft Mathematics
SERENITY,Microsoft Network Monitor 3.0
SERENITY,Microsoft Office XP Professional
SERENITY,Microsoft OpenType Font File Properties Extension
SERENITY,Microsoft Search Enhancement Pack
So there are three places where you can discard items. In the WMI select.
Set colItems = objWMIService.ExecQuery("Select * from Win32_Product where Name='Microsoft LifeCam'")
And also in the filter as shown above using similar syntax.
Also while writing it back you can compare it then and not write the ones you don't want.

Related

Having trouble with an auto updater

I am new to coding in access and I came across a simple way to update a database remotely. Attached is the directions and a stripped down version of my database. Can anyone tell me what I am doing wrong? Thanks in advance!!
This is a great module that works wonderful, but I wanted to let
people know you can do the version checking without using VBA, and
simply have an Updater application that runs the VBA to delete your
local copy and download the fresh version off the server.
I use a table called AppConstants on the server's backend that has two
columns: ConstantTitle and ConstantValue. One of the rows has
ConstantTitle set to "AppVersion" and ConstantValue set to the version
number.
Then I have a field with visibility set to False on my main form
called VersionNo, and I set this field's value to ="VersionNumber"
(where VersionNumber is the actual version number, e.g. ="1.25"). On
the Main Form's OnLoad event, I have a macro that runs a DLookup in an
IF command:
if DLookUp("[ConstantValue]", "tblAdmin", "[ConstantTitle] ='AppVersion'")<>[Forms]![frmMain]![VersionNo] Then RunCode OpenUpdater()
Quit Access
End If
The code for OpenUpdater:
Code:
Function OpenUpdater() 'This sets the name of the code to call later
Dim accapp As Access.Application
Set accapp = New Access.Application
accapp.OpenCurrentDatabase ("C:\$Data\MyUpdater.accde") 'Starts up this file
accapp.Visible = True
End Function
What it's doing: The macro checks the value of the VersionNumber in the table on the server. When I update the app copy
on the server, I set a new version number in here and set my app
copy's VersionNo field to the same number. When you're running the old
version, your app sees that the version numbers don't match, and then
it executes the Macro's 'Then' commands: it runs the OpenUpdater code
and shuts itself off.
The OpenUpdater code simply starts the MyUpdater.accde program, which
is by default installed on the user's PC along with the application
itself. The OpenUpdater program executes the following
code:
DoCmd.ShowToolbar "Ribbon", acToolbarNo
'Copy the new version to the C drive
Dim SourceFile, DestinationFile As String
SourceFile = "Z:\Server\MyProgram.accde" 'Where to get the fresh copy
DestinationFile = "C:\$Data\MyProgram.accde" 'Where to put it
With CreateObject("Scripting.FileSystemObject")
.copyfile SourceFile, DestinationFile, True 'This line does the acual copy and paste
End With
'Reopen MyProgram
Dim accapp As Access.Application
Set accapp = New Access.Application
accapp.OpenCurrentDatabase ("C:\$Data\MyProgram.accde")
accapp.Visible = True
End Function
This Function is called in a Macro within MyUpdater, and the command just after the RunCode in this Macro is QuitAccess,
which shuts off the Updater.
So my main program, when you open the main form, checks the version
number on the server. If they're different, the main program starts
the updater and then shuts itself down. The updater copies the fresh
version off the server and pastes it in the correct place on the C
drive, then starts up the program and shuts itself down.
From the end-user's perspective, the program starts, immediately
quits, and then starts again a second or so later and now it's
updated. It works awesome.
My issue is when I open up the copy database, the update doesn't run
but it runs when I go into the myupdater database and manually run the
macro. Here is the macro
If DLookUp("[ConstantValue]","AppConstants","[ConstantTitle]='AppVersion'")<>[Forms]![NavMain]![VersionNo]
Then RunCode FunctionName OpenUpdater()
Quit Access
Here is the function
Function OpenUpdater() 'This sets the name of the code to call later
Dim accapp As Access.Application
Set accapp = New Access.Application
accapp.OpenCurrentDatabase ("C:\Users\Tyrone\Desktop\MyUpdater.accde") 'Starts up this file
accapp.Visible = True
End Function
The posted code is similar to what I use. I also used script approach but I liked having all in Access and not having to install script file on each user machine. However, I did not use macro, only VBA. The VBA is behind a Login form that opens by default. Form is bound to Updates table so DLookup() is not used for the version check. gstrBasePath is a global constant declared in a general module. This uses Windows Shell so it is necessary to set reference to Microsoft Shell Controls And Automation library. Unfortunately, IT updated computers with additional restrictions that won't allow programmatic copy of files at all (was originally limited to C:\ root location) and this no longer works for me.
Private Sub Form_Load()
'Check for updates to the program on start up - if values don't match then there is a later version
If Me.tbxVersion <> Me.lblVersion.Caption Then
'because administrator opens the master development copy, only run this for non-administrator users
If DLookup("Permissions", "Users", "UserNetworkID='" & Environ("UserName") & "'") <> "admin" Then
'copy Access file
CreateObject("Scripting.FileSystemObject").CopyFile _
gstrBasePath & "Program\Install\MaterialsDatabase.accdb", "c:\", True
'allow enough time for file to completely copy before opening
Dim Start As Double
Start = Timer
While Timer < Start + 3
DoEvents
Wend
'load new version - SysCmd function gets the Access executable file path
'Shell function requires literal quote marks in the target filename string argument, apostrophe delimiters fail, hence the quadrupled quote marks
Shell SysCmd(acSysCmdAccessDir) & "MSAccess.exe " & """" & CurrentProject.FullName & """", vbNormalFocus
'close current file
DoCmd.Quit
End If
Else
'tbxVersion available only to administrator to update version number in Updates table
Me.tbxVersion.Visible = False
Call UserLogin
End If
End Sub
Private Sub tbxUser_AfterUpdate()
If Me.tbxUser Like "[A-z][A-z][A-z]" Or Me.tbxUser Like "[A-z][A-z]" Then
CurrentDb.Execute "INSERT INTO Users(UserNetworkID, UserInitials, Permissions) VALUES('" & VBA.Environ("UserName") & "', '" & UCase(Me.tbxUser) & "', 'staff')"
Call UserLogin
Else
MsgBox "Not an appropriate entry.", vbApplicationModal, "EntryError"
End If
End Sub
Private Sub UserLogin()
Me.tbxUser = DLookup("UserInitials", "Users", "UserNetworkID='" & Environ("UserName") & "'")
If Not IsNull(Me.tbxUser) Then
CurrentDb.Execute "UPDATE Users SET ComputerName='" & VBA.Environ("ComputerName") & "' WHERE UserInitials='" & Me.tbxUser & "'"
DoCmd.OpenForm "Menu", acNormal, , "UserInitials='" & Me.tbxUser & "'", , acWindowNormal
DoCmd.Close acForm, Me.Name, acSaveNo
End If
End Sub

Custom Hyperlink Title in MS Access Datasheet

I'm writing to see if anyone can tell me the fastest way of extracting filenames from a network drive I have offsite. I have some search criteria provided by users with the help of a userform in Access.
I've tried using FSO which in my experience in this situation is the slowest.
I've also tried using CMD with WScript.Shell, which is faster, but I've recorded that it take approximately 7 minutes to perform the check with the macro. Using the Windows search bar in an explorer window provides results in about a minute or less. The parent folders I am searching through have approximately 35,000 folders each containing about 1 to 2 files.
Here is the command I use with CMD with WScript.Shell :
strTemp = CreateObject("WScript.Shell").Exec("CMD /C DIR """ & "N:\" & _
Me.txtRegion.Value & "\" & Me.txtYear.Value & "\" & _
Me.txtDossier.Value & "*.*"" /S /B /A:-D").StdOut.ReadAll
The results are then split into an array and processed.
Does anyone have any suggestions for how to improve this code?

Drag and Drop File into Microsoft Access

I have a form in Microsoft Access which lets users upload attachments to each record. I'd like to make it a little user friendly by letting users drag and drop files into the attachment field. What is the best way of doing this/how do I do this?
Drag and drop might be a bit more sophisticated, how about VBA code to manipulate what you wish to achieve? This article has a great reference to what you wish to do. http://www.access-freak.com/tutorials.html#Tutorial07
Here is a way to drag and drop "attached" files for use with MS Access database.
(Currently using Office 365 Version 1811)
MS Access currently allows drag and drop to a hyperlink field.
Using this capability this example allows drag and drop to store an attachment file to a storage location while keeping a link to the original and new locations. The event runs when a file is dropped into the HyperlinkIn box on the form or when the hyperlink is changed the normal way.
It is better to store the file in a storage location with a link than to store it within the .accdb file due to the 2GB limitation. You might call this a database + file server architecture. By using the record number and optionally the database and table name and attachment number you can ensure unique file names.
Make a Table and Form with 3 fields.
ID (AutoNumber)
HyperlInkIN (hyperlink)
HyperLinkOUT (hyperlink)
Insert this VBS code for AfterUpdate event for the HyperlinkIn form control.
Private Sub HyperlinkIN_AfterUpdate()
Dim InPath As String
Dim FileName As String
Dim OutFolder As String
Dim OutPath As String
Dim RecordNo As String
Dim FileExt As String
OutFolder = "\\networkdrive\vol1\attachments\" 'specify the output folder
InPath = Me!HyperlinkIN.Hyperlink.Address
RecordNo = Me!ID
If Len(InPath) > 0 Then
FileName = Right(InPath, Len(InPath) - InStrRev(InPath, "\")) 'get the file name
FileExt = Right(FileName, Len(FileName) - InStrRev(FileName, ".") + 1) ' get the file extension with dot
'build the new path with output folder path and record number and date and extension
OutPath = OutFolder & "Record " & RecordNo & " Attachment " & Format(Now(), "ddmmmyy") & FileExt
FileCopy InPath, OutPath
Me!HyperlinkOUT = "#" & OutPath & "#"
MsgBox "Copied file to archives " & vbCrLf & InPath & vbCrLf & OutPath
End If
End Sub
I am somewhat inexperienced with vba so there may be some better ways to ensure and verify a successful file copy but this example works for me and is easy for me to understand. I used the MsgBox to help debug with the actual file copy commented out.
Because this page comes as first when searching for "MS Access drag drop", I'm adding my part here. If you are after some cool UI, you can checkout my Github for sample database using .NET wrapper dll. Which allows you to simply call a function and to open filedialog with file-drag-and-drop function. Result is returned as a JSONArray string.
code can be simple as
Dim FilePaths As String
FilePaths = gDll.DLL.ShowDialogForFile("No multiple files allowed", False)
'Will return a JSONArray string.
'Multiple files can be opend by setting AllowMulti:=true
here what it looks like;

MS Access 2003 - Sparkline Graphs in Microsoft Access

Hey guys. Just wondering if anyone knows of a method to create sparkline graphs on a form in MS Access. The chart builder does not really work very well to create sparkline charts (graphs that small).
Just curious, thanks!
I don't think there is anything built in for Sparkline graphs in MS Access. You have to use a third party control and deploy it along with your app to all users or use MS Excel embedded control to show the graph.
There is a VBA-powered sparkline solution featured on the Access blog fairly recently: http://blogs.office.com/b/microsoft-access/archive/2011/02/10/power-tip-add-sparkline-like-graphs-to-access-reports.aspx
They have an .mdb as well as an .accdb sample file available, so I'm guessing it works across multiple versions.
I started with the VBA-powered sparkline but didn't like that it looked low-resolution and I couldn't use it on a continuous form (it only works on reports). The solution I came up with was to build the charts in Excel and save the chart images in a subfolder. Then it's easy to link the image on a report or continuous form. My charts update nightly, though the Excel chart building loop is really fast. The slow part is generating the data that the charts need, which may vary depending on what you are charting.
I created a template in Excel that had a chart with the look and resolution that I wanted. I wrote a VBA routine in Access to open an Excel sheet and loop through each record that I wanted to chart. The sheet is passed to this function (below), which loads a records of chart data and passes it into Excel, which automatically refreshes the 'SparkChart' object. It then saves the image to a subfolder. The Excel sheet stays open and is re-used with each loop. I didn't include the function with the loop.
Here's what my chart looks like in Excel:
Here is an example of the Sparklines shown in a continuous form:
Public Function fCreateSparklineChart(pDQ_ID As Long, pChartSheet As Object) As Boolean
' Pass in a Dashboard Query ID for data that has already compiled into the top-n
' temp table and the data will be copied to the passed pChartSheet in Excel. This
' will update a chart object, then the chart is saved as a .png file.
Dim strSQL As String
Dim strChartPath As String
Dim rs As DAO.Recordset
On Error GoTo ErrorHandler
' Get chart data from a table that has already been compiled with
' min and max values as percentages so the lowest value is 0
' and the highest value is 100.
strSQL = " SELECT DQ_ID, Trend_Value, " & _
" IIf(Trend_Value=0,0,Null) AS Min_Point, " & _
" IIf(Trend_Value=100,100,Null) AS Max_Point " & _
" FROM " & DASHBOARD_TMP_TABLE & _
" WHERE (DQ_ID=" & pDQ_ID & ") "
strSQL = strSQL & " ORDER BY RowNo "
Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
If rs.RecordCount > 0 Then
pChartSheet.Range("A1").CurrentRegion.Clear
pChartSheet.Range("A1").CopyFromRecordset rs
pChartSheet.ChartObjects("SparkChart").Chart.SetSourceData pChartSheet.Range("rngData")
' Use a filename that includes the record ID.
strChartPath = CurrentProject.Path & "\Images\Sparkline_DQ_ID_" & Format(pDQ_ID, "0000") & ".png"
' Delete the file if it already exists.
DeleteFile strChartPath
' Save the Excel chart as a png file.
pChartSheet.ChartObjects("SparkChart").Chart.Export strChartPath, "png"
fCreateSparklineChart = True
End If
Exit_Function:
Exit Function
ErrorHandler:
fCreateSparklineChart = False
MsgBox "Error #" & err.Number & " - " & err.Description & vbCrLf & "in procedure fCreateSparklineChart of basSparkline"
GoTo Exit_Function
End Function
I've been thinking of creating a YouTube video explaining how I built this Data Quality Dashboard to chart data trends. Let me know if you are interested and I may be encouraged to do it.

Corrupt Form - Rescue or Remake?

During my work on this database application, I've apparently managed to corrupt a form in the application - attempting to save any edit to any field on the form will cause Access to crash, and for the database file to report corrupted when Access attempts to re-open it.
I've tried exporting the entire form + controls as text, then re-importing them using VB code (from Allen Browne's website) but it will not re-import without either crashing Access or telling me the form isn't import-able due to an error (no error number or description given).
The form is rather complex, hence I am hesitant to just remake it from scratch, so is there a way to save it? If I do manage to recover it, does this mean I should transfer everything to a new MDB file (in case it's a cascading failure effect)?
To be honest, I've never managed to corrupt an Access database object before, so I don't know if this is something that signals the end of that MDB file, or just something I can correct and continue as before.
Decompile is a good thing to try once you've made a copy of the database. Have you tried saving the form under a different name using File >> Save As? Also try copying and pasting the form with a different name from the database window.
Also it's been my experience that one corrupt form/report does not spread to the rest of the database. That said it doesn't hurt to clean things up. Compact and repair only fixes up tables and related data such as indexes and relationships. To clean up corrupted other objects such as forms and reports you must import them into a new MDB/ACCDB. Tip: Close the database container window if you have a lot of objects. Access wastes a lot of time during the import refreshing the database container window.
What I ended up having to do was re-create the form, and copy element by element until I discovered that the strSupplierID combo box itself was the cause of the crashing. I re-created it from scratch, manually giving it the same properties, and replacing the VB from stored copies I cut and pasted to the clipboard. The form now works, and I removed the corrupted form, and compacted the database. Thanks for the help, everyone! :)
Others have supplied you with various approaches to possibly recover your corrupted form. Sometimes an code-bearing Access object will become irretrievably corrupt and none of these methods will work. In that case, you'll have to look= at backups to find a non-corrupt version as a starting point and import that and then revise it back to the current state of the object.
I'm posting an answer to suggest that you probably need to change your coding practices if you're encountering corruption in code-bearing objects.
First, you need to make sure you keep regular backups and do not overwrite them. Rolling back to an earlier version is always a last resort.
Always turn off COMPILE ON DEMAND in the VBE options. Read Michael Kaplan's article on The Real Deal on the Decompile Switch for the explanation of why.
In the VBE, add the compile button (and the call stack button) to your regular VBE toolbar, and hit that compile button after every few lines of code, and save your code.
Decide on a reasonable interval to backup and decompile your app. If you're doing heavy-duty code pounding, you might want to do this every day. If you've experienced an Access crash during coding, you likely want to make your backup and decompile/recompile. Certainly before distributing to users, you should decompile and recompile your app.
If you follow these practices, the causes of corruption in code-bearing Access objects will be minimized as much as possible, while you will also have plenty of backups (multiple levels of redundant backups are a must, because when backup failures happen, they almost always cascade through multiple levels -- have several types of backup and don't depend on an automatic backup).
But the key point:
Compile often, decompile reasonably often and icky stuff will never have a chance to accumulate in the p-code of your application.
Have you looked at the full set of methods for dealing with corruption from Allen Browne: http://allenbrowne.com/ser-47.html ? In particular, decompile.
It may be worth try a copy and paste of the controls into a new form and gradually add back in the code.
I have had that happen to me many times. Here are a couple things that have saved my bacon. I am assuming you are using Access 2003 or higher. Try converting the database to Access 2002 or 2000 format. Then convert that database back to your current version.
Here is some code that I created to combat bloat in previous versions. It also solved this issue for me 95% of the time.
Option Compare Database
Option Explicit
Private Sub cmdCreateDuplicate_Click()
'********************************************************
' Author Daniel Tweddell
' Revision Date 10/27/05
'
' To Combat bloat, we are recreating the a new database
'********************************************************
On Error GoTo Err_Function
Dim strNewdb As String
Dim AppNewDb As New Access.Application 'the new database we're creating to manage the updates
strNewdb = CurrentProject.Path & "\db1.mdb"
SysCmd acSysCmdSetStatus, "Creating Database. . ."
With AppNewDb
DeleteFile strNewdb 'make sure it's not already there
.Visible = False 'hear no database see no database
.NewCurrentDatabase strNewdb 'open it
ChangeRemoteProperty "StartupShowDbWindow", AppNewDb, , dbBoolean, False
ChangeRemoteProperty "Auto compact", AppNewDb, , dbBoolean, True
ImportReferences AppNewDb, Application
.CloseCurrentDatabase
End With
Set AppNewDb = Nothing
Dim ao As AccessObject
For Each ao In CurrentData.AllTables
If Left(ao.Name, 4) <> "msys" Then
DoCmd.TransferDatabase acExport, "Microsoft Access", strNewdb, acTable, ao.Name, ao.Name
SysCmd acSysCmdSetStatus, "Exporting " & ao.Name & ". . ."
End If
Next
For Each ao In CurrentData.AllQueries
DoCmd.TransferDatabase acExport, "Microsoft Access", strNewdb, acQuery, ao.Name, ao.Name
SysCmd acSysCmdSetStatus, "Exporting " & ao.Name & ". . ."
Next
For Each ao In CurrentProject.AllForms
DoCmd.TransferDatabase acExport, "Microsoft Access", strNewdb, acForm, ao.Name, ao.Name
SysCmd acSysCmdSetStatus, "Exporting " & ao.Name & ". . ."
Next
For Each ao In CurrentProject.AllReports
DoCmd.TransferDatabase acExport, "Microsoft Access", strNewdb, acReport, ao.Name, ao.Name
SysCmd acSysCmdSetStatus, "Exporting " & ao.Name & ". . ."
Next
For Each ao In CurrentProject.AllMacros
DoCmd.TransferDatabase acExport, "Microsoft Access", strNewdb, acMacro, ao.Name, ao.Name
SysCmd acSysCmdSetStatus, "Exporting " & ao.Name & ". . ."
Next
For Each ao In CurrentProject.AllModules
DoCmd.TransferDatabase acExport, "Microsoft Access", strNewdb, acModule, ao.Name, ao.Name
SysCmd acSysCmdSetStatus, "Exporting " & ao.Name & ". . ."
Next
MsgBox "Creation Complete!" & vbCrLf & "Reset Password", vbExclamation, "New Database"
Exit Sub
Err_Function:
ErrHandler Err.Number, Err.Description, Me.Name & " cmdCreateDuplicate_Click()"
End Sub
Function DeleteFile(ByVal strPathAndFile As String) As Boolean
'***********************************************************************************
' Author Daniel Tweddell
' Revision Date 04/14/03
'
' Deletes a file
'***********************************************************************************
On Error GoTo Err_Function
DeleteFile = True 'default to true
If UncDir(strPathAndFile) <> "" Then 'make sure the file is there
Kill strPathAndFile 'delete a file
End If
Exit Function
Err_Function:
ErrHandler Err.Number, Err.Description, "DeleteFile()", bSilent
DeleteFile = False 'if there is a problem, false
End Function
Public Sub ChangeRemoteProperty(strPropName As String, _
appToDB As Access.Application, Optional appFromDB As Access.Application, _
Optional vPropType As Variant, Optional vPropValue As Variant)
'********************************************************************************
' Author Daniel Tweddell
' Revision Date 01/13/04
'
' Changes/adds a database property in one db to match another
'********************************************************************************
On Error GoTo Err_Function
Dim ToDB As DAO.Database
Dim FromDB As DAO.Database
Dim prpTest As DAO.Property
Dim bPropertyExists As Boolean
Set ToDB = appToDB.CurrentDb
If Not appFromDB Is Nothing Then Set FromDB = appFromDB.CurrentDb
bPropertyExists = False 'flag to see if we found the property
For Each prpTest In ToDB.Properties 'first see if the property exists so we don't error
If prpTest.Name = strPropName Then
If IsMissing(vPropValue) Then vPropValue = FromDB.Properties(strPropName) 'in case we want to assign it a specific value
ToDB.Properties(strPropName) = vPropValue 'if it does set it and get out or the loop
bPropertyExists = True
Exit For
End If
Next
If Not bPropertyExists Then ' Property not found.
Dim prpChange As DAO.Property
If IsMissing(vPropValue) Then
With FromDB.Properties(strPropName)
vPropValue = .Value 'in case we want to assign it a specific value
vPropType = .Type
End With
End If
Set prpChange = ToDB.CreateProperty(strPropName, vPropType, vPropValue) 'add it
ToDB.Properties.Append prpChange
End If
Exit Sub
Err_Function:
ErrHandler Err.Number, Err.Description, "ChangeRemoteProperty()", bSilent
End Sub
Public Sub ImportReferences(AppNewDb As Access.Application, appUpdateDB As Access.Application, Optional iStatus As Integer)
'********************************************************************************
' Author Daniel Tweddell
' Revision Date 01/13/04
'
' Copies the current references from the one database to another we're building
'********************************************************************************
On Error GoTo Err_Function
Dim rNewRef As Reference
Dim rUpdateRef As Reference
Dim bReferenceExists As Boolean
Dim rToAdd As Reference
Dim sReference As String
If iStatus <> 0 Then ProgressBarUpdate iStatus, "Referencing Visual Basic Libraries. . ."
For Each rUpdateRef In appUpdateDB.References
bReferenceExists = False
For Each rNewRef In AppNewDb.References
sReference = rNewRef.Name
If rUpdateRef.Name = sReference Then
bReferenceExists = True
Exit For
End If
Next
If Not bReferenceExists Then
With rUpdateRef
Set rToAdd = AppNewDb.References.AddFromGuid(.Guid, .Major, .Minor)
End With
End If
Next
Exit Sub
Err_Function:
ErrHandler Err.Number, Err.Description, "ImportReferences(" & sReference & ")", bSilent
Resume Next
End Sub
I have found that combo boxes with 10 or more columns can cause an Access form to corrupt. Try reducing the number of the columns or removing that combo box to see if the form saves properly. This problem is was related to working in Win 7 64 bit operating system with Access 2003 databases. There was no problem when developing in XP in other words the forms save fine with large column counts in combo boxes. Hope this information helps since it caused a lot of wasted time thinking the database was corrupted.