Per,

Thanks for putting together the modified code, especially in such a short
time span. I greatly appreciate it.

Regards,
Bob


"Per Jessen" wrote:

Bob,

Thanks for your reply. I am glad to help.

This is workbook eventcode, so it has to be pasted into the code sheet
for ThisWorkbook.

Private Sub Workbook_Open()
Dim strFile As String
Dim objWShell As Object, strFolder As String
Dim ID As Long
On Error Resume Next
Do
ID = InputBox("Enter valid ID", "Student ID")
Loop Until ID = 10000 And ID < 100000
On Error GoTo 0
strFile = "Student Questionnaire " & ID & ".xls"
If Val(Application.Version) < 12 Then
FileExtStr = ".xls": FileFormatNum = -4143
Else
FileExtStr = ".xls": FileFormatNum = 56
End If
Set objWShell = CreateObject("WScript.Shell")
strFolder = objWShell.SpecialFolders("Desktop")
ActiveWorkbook.SaveAs strFolder & "\" & strFile,
FileFormat:=FileFormatNum
Set objWShell = Nothing
End Sub

Regards,
Per

On 20 Aug., 03:21, Bob wrote:
Per,

Thanks for your help!

Although Jacob and you came up with slightly different methodologies, it was
very helpful to see how two programmers approach and solve the same problem.
Being relatively new to VBA, studying Jacob's and your code was a good
learning experience for me.

Thanks again for taking the time to help me out.

Bob



"Per Jessen" wrote:
Hi Bob

This should do it. Please notice the this is event code, so it has to be
pasted into the codesheet for the desired sheet:

Private Function GetDesktopPath() As String
Dim objShell As Object
Dim objFolderDsk As Object
Dim strDsk As String
Set objShell = CreateObject("Shell.Application")
Set objFolderDsk = objShell.Namespace(&H10&)
strDsk = objFolderDsk.Self.Path
GetDesktopPath = strDsk
Set objShell = Nothing
End Function

Private Sub Worksheet_Change(ByVal Target As Range)
Dim StudID As String
Dim DestPath As String
Dim SaveAsFileName As String
Set isect = Intersect(Target, Range("B12"))
If Not isect Is Nothing Then
DestPath = GetDesktopPath()
StudID = Range("B12").Value
SaveAsFileName = "\Student Questionnaire " & StudID & ".xls"
If Application.Version = 12# Then
ThisWorkbook.SaveAs Filename:=DestPath & SaveAsFileName,
FileFormat:=xlExcel8
Else
ThisWorkbook.SaveAs Filename:=DestPath & SaveAsFileName
End If
End If
End Sub

Regards,
Per

"Bob" skrev i meddelelsen
...
I have created a questionnaire. Midway through it, I ask the user for
their
student ID (located in cell B12). After the user has inputted their ID
and
pressed either the Enter key or an arrow key, I would like the worksheet
to
automatically Save itself to the user's Desktop with the filename:
"Student
Questionnaire xxxxx.xls" where "xxxxx" is the user's student ID.

Please note that some students use Excel 2003 while others use Excel 2007.
However, I need to have the worsheet saved in the Excel 2003 file format.

Being relatively new to VBA, I have no idea how to program this. Can
anyone
help me?

Thanks,
Bob- Skjul tekst i anførselstegn -

- Vis tekst i anførselstegn -