Export/Import in CSV
 

I have a sheet in my workbook (written in Excel 2003), that is bombing when
run in Excel 2007. The purpose is to let the user enter data on uncompleted
jobs, save the sheet (with the job name) and to allow them to import the job
later and update the data until the job is done. They can have 100's of jobs.
I suspect this is an issue with the naming convention in 2007, but I don't
have Excel 2007 to test. Can someone help figure out what the issue is and
fix it so that it will work in both 2003 and 2007 of offer a better
suggestion (I looked at just doing a CSV/TXT file but can't figure out how to
export/import just the cells with the data points and leave the formulas
alone)? Thanks so much! Here is the code:

Dim wsoutput As Worksheet
Dim JNum As String
Dim MyDirectory As String
Dim DirTest As String
Dim DefPath As String

'Checks to See If A Directory Exists, If Not, Creates It
MyDirectory = ActiveWorkbook.Path & "\" & "2009 Saved Jobs"
DirTest = Dir$(MyDirectory, vbDirectory)
If DirTest = "" Then
MkDir MyDirectory
DoEvents 'just to make sure it is there
End If
ChDir MyDirectory

DefPath = MyDirectory

If Right(DefPath, 1) < "\" Then
DefPath = DefPath & "\"
End If

Set wsoutput = Sheet96
JNum = Sheet96.Range("E5")

wsoutput.Select
wsoutput.Copy

Cells.Select
Range("A1").Activate
ActiveWorkbook.Colors(53) = RGB(247, 252, 255)
Range("A1").Select

If Range("H42") = 0 Then
Do
FName = Application.GetSaveAsFilename("Job " & JNum, filefilter:="Excel
Files (*.xls), *.xls")
Loop Until FName < False Or msoButtonSetCancel

Else
Do
FName = Application.GetSaveAsFilename("Job " & JNum & "C",
filefilter:="Excel Files (*.xls), *.xls")
Loop Until FName < False Or msoButtonSetCancel

End If

If FName < False Then
ActiveWorkbook.SaveAs FName
ActiveWorkbook.Close SaveChanges:=False
Else: Exit Sub
End If

ChDir CurDir & "\.."

'ActiveWindow.Close

End Sub

Export/Import in CSV
 

This is the code to Import the data that the above code creates

Sub RetrieveMWJCJob()
'
' RetrieveMWJCJob Macro
' Macro recorded 11/15/2006 by David Perkins
'

'
Call ZeroMWJCSheet

Dim MyDirectory As String

'Moves to 2009 Saved Jobs Directory
MyDirectory = ActiveWorkbook.Path & "\" & "2009 Saved Jobs"

ChDir MyDirectory

Do
FName = Application.GetOpenFilename
Loop Until FName < False Or msoButtonSetCancel

If FName < False Then
Set ImportFile = Workbooks.Open(FileName:=FName)
Else: Exit Sub
End If

Application.ScreenUpdating = False

Dim password As String

ThisWorkbook.Activate
Sheet91.Select
Range("CA3").Select
password = Range("CA3").Value

Sheet96.Select
ActiveSheet.Unprotect (password)

ImportFile.Activate
Range("E5").Select
Application.CutCopyMode = False
Selection.Copy
ThisWorkbook.Activate
Range("E5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False

ImportFile.Activate
Range("D6:F9").Select
Application.CutCopyMode = False
Selection.Copy
ThisWorkbook.Activate
Range("D6:F9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False

ImportFile.Activate
Range("B6:B9").Select
Application.CutCopyMode = False
Selection.Copy
ThisWorkbook.Activate
Range("B6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False

ImportFile.Activate
Range("H6").Select
Application.CutCopyMode = False
Selection.Copy
ThisWorkbook.Activate
Range("H6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False

ImportFile.Activate
Range("B13:B16").Select
Application.CutCopyMode = False
Selection.Copy
ThisWorkbook.Activate
Range("B13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False

ImportFile.Activate
Range("H13").Select
Application.CutCopyMode = False
Selection.Copy
ThisWorkbook.Activate
Range("H13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False

ImportFile.Activate
Range("B20:B23").Select
Application.CutCopyMode = False
Selection.Copy
ThisWorkbook.Activate
Range("B20").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False

ImportFile.Activate
Range("H20").Select
Application.CutCopyMode = False
Selection.Copy
ThisWorkbook.Activate
Range("H20").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 11

ImportFile.Activate
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 17
Range("B28:B31").Select
Application.CutCopyMode = False
Selection.Copy
ThisWorkbook.Activate
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 17
Range("B28").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False

ImportFile.Activate
Range("H28").Select
Application.CutCopyMode = False
Selection.Copy
ThisWorkbook.Activate
Range("H28").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False

ImportFile.Activate
Range("B35:B38").Select
Application.CutCopyMode = False
Selection.Copy
ThisWorkbook.Activate
Range("B35").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False

ImportFile.Activate
Range("H35").Select
Application.CutCopyMode = False
Selection.Copy
ThisWorkbook.Activate
Range("H35").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False

ImportFile.Activate
Range("B42:B45").Select
Application.CutCopyMode = False
Selection.Copy
ThisWorkbook.Activate
Range("B42").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False

ImportFile.Activate
Range("H42").Select
Application.CutCopyMode = False
Selection.Copy
ThisWorkbook.Activate
Range("H42").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False

ImportFile.Activate
ActiveWindow.Close
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 1
Range("A1").Select

ActiveSheet.Protect (password)

Kill FName

ChDir CurDir & "\.."

Application.ScreenUpdating = True
End Sub

Export/Import in CSV
 

NEVER MIND...I found Ron's work on this and got mostly what I needed...Thanks
if you were working on this already!!

"David" wrote:

I have a sheet in my workbook (written in Excel 2003), that is bombing when
run in Excel 2007. The purpose is to let the user enter data on uncompleted
jobs, save the sheet (with the job name) and to allow them to import the job
later and update the data until the job is done. They can have 100's of jobs.
I suspect this is an issue with the naming convention in 2007, but I don't
have Excel 2007 to test. Can someone help figure out what the issue is and
fix it so that it will work in both 2003 and 2007 of offer a better
suggestion (I looked at just doing a CSV/TXT file but can't figure out how to
export/import just the cells with the data points and leave the formulas
alone)? Thanks so much! Here is the code:

Dim wsoutput As Worksheet
Dim JNum As String
Dim MyDirectory As String
Dim DirTest As String
Dim DefPath As String

'Checks to See If A Directory Exists, If Not, Creates It
MyDirectory = ActiveWorkbook.Path & "\" & "2009 Saved Jobs"
DirTest = Dir$(MyDirectory, vbDirectory)
If DirTest = "" Then
MkDir MyDirectory
DoEvents 'just to make sure it is there
End If
ChDir MyDirectory

DefPath = MyDirectory

If Right(DefPath, 1) < "\" Then
DefPath = DefPath & "\"
End If

Set wsoutput = Sheet96
JNum = Sheet96.Range("E5")

wsoutput.Select
wsoutput.Copy

Cells.Select
Range("A1").Activate
ActiveWorkbook.Colors(53) = RGB(247, 252, 255)
Range("A1").Select

If Range("H42") = 0 Then
Do
FName = Application.GetSaveAsFilename("Job " & JNum, filefilter:="Excel
Files (*.xls), *.xls")
Loop Until FName < False Or msoButtonSetCancel

Else
Do
FName = Application.GetSaveAsFilename("Job " & JNum & "C",
filefilter:="Excel Files (*.xls), *.xls")
Loop Until FName < False Or msoButtonSetCancel

End If

If FName < False Then
ActiveWorkbook.SaveAs FName
ActiveWorkbook.Close SaveChanges:=False
Else: Exit Sub
End If

ChDir CurDir & "\.."

'ActiveWindow.Close

End Sub