Problem With Code...Still
I tried the code and it looks cleaner. Thank you. The file does get created
like it is supposed to do and what happens afterwards is a Run-time error
'9': Subscript out of range message shows up. When I remove the code ....
With Workbooks(FileName1).Sheets(1).Cells
.Value = .Value
End With
No errors will appear and the file will get created along with references
and formulas.
"JLGWhiz" wrote:
OK NFL, I think I have figured out the problem. Your If Then ElseIf is
causing vba to skip the last two options if the first one is true. If I remove the ..
With Workbooks(FileName1).Sheets(1).Cells
.Value = .Value
End With
The code is a little confusing as written, but it looks as if you want to
check if a file exists and if so, exit the process. If the file does not
exist then create the file from sheet 18. If that is true then this should
work.
Private Sub CommandButton6_Click()
Dim message As String, FolderName1 As String, FileName1 As String
Set MyComputer = CreateObject("Scripting.FileSystemObject")
FolderName1 = Range("F6").Value
FileName1 = Range("M6").Value
If MyComputer.FolderExists(FolderName1) = False Then
message = MsgBox("The directory: " & FolderName1 & _
", does not exist." & Chr(10) & "Enter a new directory" & _
"path (cell F6).", 0, "Not today my friend.")
ElseIf MyComputer.FileExists(FileName1) = True Then
message = MsgBox("The file name: " & FileName1 & _
", already exists." & Chr(10) & "A copy of this file" & _
"has NOT been saved.", 0, "Not today my friend.")
Exit Sub
End If
Sheet18.Visible = xlSheetVisible
Sheets("Export").Copy
ActiveWorkbook.SaveAs Filename:=FileName1, FileFormat:=xlNormal
With Workbooks(FileName1).Sheets(1).Cells
.Value = .Value
End With
ActiveWorkbook.Close SaveChanges:=True
End Sub
"JLGWhiz" wrote in message
...
I did not test this, but it should work if the values in F6 and M6 are
valid names and properly configured. If it does not work, then post back
with any error messages received and what line of code is highlighted when
the error occurs.
Private Sub CommandButton6_Click()
Dim message As String, FolderName1 As String, FileName1 As String
Set MyComputer = CreateObject("Scripting.FileSystemObject")
FolderName1 = Range("F6").Value
FileName1 = Range("M6").Value
If MyComputer.FolderExists(FolderName1) = False Then
message = MsgBox("The directory: " & FolderName1 & _
", does not exist." & Chr(10) & "Enter a new directory" & _
"path (cell F6).", 0, "Not today my friend.")
ElseIf MyComputer.FileExists(FileName1) = True Then
message = MsgBox("The file name: " & FileName1 & _
", already exists." & Chr(10) & "A copy of this file" & _
"has NOT been saved.", 0, "Not today my friend.")
Else
Sheet18.Visible = xlSheetVisible
Sheets("Export").Copy
ActiveWorkbook.SaveAs Filename:=FileName1, FileFormat:=xlNormal
With Workbooks(FileName1).Sheets(1).Cells
.Value = .Value
End With
ActiveWorkbook.Close
End If
End If
End Sub
"NFL" wrote in message
...
I posted a message earlier and been trying to figure out why this code
doesn't work right. Thank you for all your help.
Private Sub CommandButton6_Click()
Dim message As String
Set MyComputer = CreateObject("Scripting.FileSystemObject")
FolderName1 = Range("F6")
FileName1 = Range("M6")
If MyComputer.FolderExists(FolderName1) = False Then
message = MsgBox("The directory: " & FolderName1 & ", does not
exist." & Chr(10) _
& "Enter a new directory path (cell F6).", 0, "Not today my
friend.")
Else
If MyComputer.FileExists(FileName1) = True Then
message = MsgBox("The file name: " & FileName1 & ", already
exists." & Chr(10) _
& "A copy of this file has NOT been saved.", 0, "Not today my
friend.")
Else
Sheet18.Visible = xlSheetVisible
Sheets("Export").Copy
ActiveWorkbook.SaveAs Filename:=FileName1, FileFormat:=xlNormal
With Workbooks(FileName1).Sheets(1).Cells
.Value = .Value
End With
ActiveWindow.Close
End If
End If
End Sub
.
|