'Program code for VBA for Excel 'It will scan, save and link documents in the spreadsheet. 'Filenames made up from data out of other cells on the same row. 'Automaticly adds the hyperlink to that file on the same row. ' 'Date: 20-feb-2008 Belgium. MichelR-be(at)gmail(dot)com ' 'Thanks to the free scanner command-TWAIN program from GssSoftware: 'http://www.gssezisoft/go.php?i=CmdTwain ' 'Just copy the text running MS-Excel under: '>>>Tool\Macro\VisualBasicEditor\VBAProjects\MicrosoftExcelObjects\Sheets1 'Then add the column name 'scan' on the first row and other columns like Firm, Date, EURO, ... 'Scanner will start and add the link to the scanned document 'on the row where you have entered the number 1 in the column 'scan' ' ' Private Sub Worksheet_Change(ByVal oTarget As Range) If UCase(oTarget.EntireColumn.Rows(1).Value) <> "SCAN" Then Exit Sub 'Only start when in the column "SCAN" If oTarget.Count <> 1 Then Exit Sub 'stop when more then 1 cell changes at ones If Not IsNumeric(oTarget.Value) Or oTarget.Value = 0 Then Exit Sub 'only scan when there is a number been entered vScanPrg = "C:\Program Files\GssSoftware\CmdTwain\CmdTwain.exe /PAPER=A4 /DPI=200 /JPG25" Set oFSO = CreateObject("Scripting.FileSystemObject") 'to have diskaccess vFolder = ThisWorkbook.Path & "\ScanDocs" 'Folder to save the documents vFileExt = ".jpg" If Not oFSO.FolderExists(vFolder) Then oFSO.CreateFolder (vFolder) vFile = oTarget.EntireColumn.Rows(1).NoteText 'filename set-up hidden in comment on top row 'getting and checking the filename vError = "" Do 'enter how the filenames should be made up from values out of other columns If vFile = "" Then vFile = InputBox(vError & Chr(13) _ & "Enter the filename for the scans:" & Chr(13) _ & "use: * " & Chr(13) _ & "example: myscans EUR", "SAVE SCANS TO") If vFile = "" Then Exit Sub oTarget.EntireColumn.Rows(1).NoteText vFile oTarget.EntireColumn.Rows(1).Comment.Shape.TextFrame.AutoSize = True End If If InStr(vFile, "\") Or InStr(vFile, "/") Or InStr(vFile, "?") Or InStr(vFile, "*") _ Or InStr(vFile, ".") Or InStr(vFile, ":") Or InStr(vFile, "|") Or InStr(vFile, Chr(34)) Then vError = "Don't include a file-extension and \ / ? * " & Chr(34) & " : . | can't be used !" vFile = "" End If Loop Until vFile <> "" Do 'change all columnnames between < and > with the values in those columns vLoc = InStr(1, vFile, "<") vLen = InStr(vLoc, vFile, ">") - vLoc - 1 vFind = Mid(vFile, vLoc + 1, vLen) Set oFound = ActiveSheet.Rows(1).Find(vFind, LookIn:=xlValues, LookAt:=xlWhole) If IsEmpty(oFound) Then ' if the columnname isn't been found vFound = "" Else vFound = oFound.EntireColumn.Rows(oTarget.Row).Value 'take the value from the column End If If IsDate(vFound) Then vFound = Format(vFound, "YYYY-MM-DD") 'change date-format vFile = Left(vFile, vLoc - 1) & vFound & Mid(vFile, vLoc + vLen + 2) Loop Until InStr(1, vFile, "<") = 0 If vFile = "" Then vFile = "ScanDoc" vExtra = "" Do 'enter an unique number to the file if it already exist If Not oFSO.FileExists(vFolder & vFile & vExtra & vFileExt) Then Exit Do vExtra = Val(vExtra) + 1 Loop vFile = vFile & vExtra & vFileExt Application.EnableEvents = False 'stop trigering this routine when adding the document-link to the sheet oTarget.Formula = "=hyperlink(" & Chr(34) & vFolder & "\" & vFile & Chr(34) & "," & Chr(34) & vFile & Chr(34) & ")" Application.EnableEvents = True ' now start the dos CmdTwain.exe from GssSoftware to scan-to-file Call Shell(vScanPrg & " " & Chr(34) & vFolder & "\" & vFile & Chr(34), vbMinimizedNoFocus) ' while scanning one can keep on typing into the Excel-sheet... End Sub