Trouble with UserName

[Jim Berglund]

1. Is there a 'Standard' term for User and User Name? I'm trying to save a
file to a user's desktop. and have written the following, which grinds to a
stop in the If statement at the bottom. How should I write this?
2. I want to also copy the contents of a textbox into the new file. The
textbox is called "Textbox 1" in the Excel Spreadsheet. How can I bring it
across?

Thanks
Jim Berglund


Sub CreateCallList() 'Create a new file on the Desktop
Dim wsCList As Worksheet
Dim wb As Workbook
Dim Textbox_1 As TextBox
Dim Response, UserName As String

Application.ScreenUpdating = False
Set wb = ThisWorkbook
Set wsCList = wb.Worksheets("Call List")

wsCList.Activate
With ActiveSheet

.Range("$A:$G").Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme,
Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Response = MsgBox("This will paste these values into a new worksheet
on your Desktop called Call List.xls", vbOKCancel)
If Response = vbOK Then
ActiveWorkbook.SaveAs Filename:="C:\Users\" & UserName &
"\Desktop\Call List1.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False,
_
CreateBackup:=False
End If

End With
End Sub

 

[Jim Berglund]

I have the file saved - but I still need to know how to move the Textbox...
Jim

 

[GS]

Jim Berglund submitted this idea :

1. Is there a 'Standard' term for User and User Name? I'm trying to save a
file to a user's desktop. and have written the following, which grinds to a
stop in the If statement at the bottom. How should I write this?
2. I want to also copy the contents of a textbox into the new file. The
textbox is called "Textbox 1" in the Excel Spreadsheet. How can I bring it
across?

Thanks
Jim Berglund

Hi Jim,
Is there a reason why you can't copy the entire sheet to a new
workbook?

If you can copy then:
ThisWorkbook.Sheets("Call List").Copy

Else, To copy the data and textbox to a new workbook:

Sub Create_CallListFile()
' Creates a new file on the Desktop
Dim wksSource As Worksheet, wksTarget As Worksheet
Dim wkbTarget As Workbook
Dim lLastRow As Long, lLeft As Long, lTop As Long
Dim vAns As Variant

Set wksSource = ThisWorkbook.Sheets("Call List")
lLastRow = wksSource.UsedRange.Rows.Count
With wksSource.Shapes("TextBox1")
lLeft = .Left: lTop = .Top
End With

Application.ScreenUpdating = False
Set wkbTarget = Workbooks.Add: Set wksTarget = wkbTarget.ActiveSheet

'Copy the data to wksTarget
wksSource.Range("$A$1:$G$" & CStr(lLastRow)).Copy _
Destination:=wksTarget.Range("$A$1")

'Copy & paste the textbox to the same location on wksTarget
wksSource.Shapes("TextBox1").Copy: wksTarget.Paste
With wksTarget.Shapes("TextBox1")
.Top = lTop: .Left = lLeft
End With
Application.CutCopyMode = False

'Ask if user wants to save to the Desktop
vAns = MsgBox("This will paste these values into a new workbook on
your Desktop called 'Call List.xls'", vbOKCancel)
If vAns = vbOK Then wkbTarget.SaveAs "C:\Documents and Settings\" _
& Environ("username") _
& "\Desktop\Call List1.xls"
End Sub

regards,

 

[Gary Keramidas]

environ("username") return the user's name
environ("userprofile") will return the path to their user folder so
appending will put the file on their desktop

environ("userprofile") & "\Desktop\" & "Call List1.xls"

somebody wrote this, don't remember who, but run this code in a new workbook
to get the environment variable values. i added line numbers in case the
code gets wrapped.

--


Gary Keramidas
Excel 2003

Option Explicit
Sub EnvironListing()
'Note: Usage of Environ is limited to VBA only. This macro just
creates a list of
' variables and their return value, to show you what VBA can
return for you
'
'Example: The following line of code, when used in a macro, will
create a messagebox
' with the username signed into the computer
' Msgbox Environ("username")
' Note: using Msgbox Environ(31) will return
USERNAME=computerusername, where
' Msgbox Environ("username") will return just the username
Dim i As Integer, wb As Workbook
10 Application.ScreenUpdating = False
20 Application.DisplayAlerts = False

'To create a new workbook if nothing open, otherwise create a new
sheet
30 On Error Resume Next
40 Set wb = ActiveWorkbook
50 On Error GoTo 0
60 If wb Is Nothing Then
70 Workbooks.Add
80 Else
90 wb.Sheets.Add
100 End If

'Creates a list of environ arguments, in the form
ARGUMENT=EnvironString
110 i = 1
120 Do Until Environ(i) = ""
130 Cells(i, 1) = Environ(i)
140 i = i + 1
150 Loop

'Separates the column into environ argument, and return value for
that argument
160 Range("A1:A" & i - 1).TextToColumns DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True,
OtherChar:="="

'Autofit columns for easier readability
170 Columns.AutoFit
180 Application.DisplayAlerts = True
190 Application.ScreenUpdating = True
End Sub

 

[Jim Berglund]

Thanks, GS. That worked perfectly!
Jim

Jim Berglund submitted this idea :

Hi Jim,
Is there a reason why you can't copy the entire sheet to a new workbook?

If you can copy then:
ThisWorkbook.Sheets("Call List").Copy

Else, To copy the data and textbox to a new workbook:

Sub Create_CallListFile()
' Creates a new file on the Desktop
Dim wksSource As Worksheet, wksTarget As Worksheet
Dim wkbTarget As Workbook
Dim lLastRow As Long, lLeft As Long, lTop As Long
Dim vAns As Variant

Set wksSource = ThisWorkbook.Sheets("Call List")
lLastRow = wksSource.UsedRange.Rows.Count
With wksSource.Shapes("TextBox1")
lLeft = .Left: lTop = .Top
End With

Application.ScreenUpdating = False
Set wkbTarget = Workbooks.Add: Set wksTarget = wkbTarget.ActiveSheet

'Copy the data to wksTarget
wksSource.Range("$A$1:$G$" & CStr(lLastRow)).Copy _
Destination:=wksTarget.Range("$A$1")

'Copy & paste the textbox to the same location on wksTarget
wksSource.Shapes("TextBox1").Copy: wksTarget.Paste
With wksTarget.Shapes("TextBox1")
.Top = lTop: .Left = lLeft
End With
Application.CutCopyMode = False

'Ask if user wants to save to the Desktop
vAns = MsgBox("This will paste these values into a new workbook on your
Desktop called 'Call List.xls'", vbOKCancel)
If vAns = vbOK Then wkbTarget.SaveAs "C:\Documents and Settings\" _
& Environ("username") _
& "\Desktop\Call List1.xls"
End Sub

regards,

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

 

[GS]

Jim Berglund brought next idea :

Thanks, GS. That worked perfectly!
Jim

You're welcome! Glad to be of help...