help with network script...

  • Thread starter Thread starter RompStar
  • Start date Start date
the top is right

Sub ChDirNet(szPath As String)
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
End Sub

just pasted it incorrectly
 
It's for the workbook that you're opening and copying from. It doesn't look
like you want to change that (even by mistake).
 
You dropped and changed a couple of lines.

Option Explicit

Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long

Sub ChDirNet(szPath As String)
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
End Sub

Sub ImportRetroBoxDailyFiles()
Dim Resp As Long
Dim networkPath As String
Dim MyFileName As Variant
Dim CurDriveFolder As String
Dim newWkbk As Workbook
Dim testRange As Range

networkPath = "\\HARDWARE\Requests\test_network_append\"

CurDriveFolder = CurDir

On Error Resume Next
ChDirNet networkPath
If Err.Number <> 0 Then
MsgBox "error changing folder"
Err.Clear
End If
On Error GoTo 0

MyFileName = Application.GetOpenFilename("Excel Files, *.xls")
If MyFileName = False Then
'do nothing, user hit cancel
Else
Set newWkbk = Workbooks.Open(Filename:=MyFileName)
Set testRange = Nothing
On Error Resume Next
Set testRange = newWkbk.Names("Pick_Ups").RefersToRange
On Error GoTo 0

If testRange Is Nothing Then
MsgBox "Pick_UPs wasn't found!"
Else
If testRange.Rows.Count < 2 Then
'if less then 2 rows, must be only headers , Ignore
MsgBox "Only Headers!" ' pop-up a box is only headers found
Else
With testRange
.Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0).Copy
_
Destination:=ThisWorkbook.Worksheets("Import") _
.Range("B65536").End(xlUp).Offset(0, 0)
End With
End If
End If
End If

newWkbk.Close savechanges:=False

'thisworkbook.save '<---are you sure you want to save this workbook??

ChDirNet CurDriveFolder

End Sub

But I still have heartburn over your .offset(0,0). I think you'll find that it
may be overwriting a cell with something in it.
 
I think I am a little bit lost: here is how the script looks exactly as
of now, I tried to change that area:

If testRange.Rows.Count < 2 Then
MsgBox "Only Headers!"
Else
With testRange
..Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0).Copy _
Destination:=ThisWorkbook.Worksheets("Import").Range("B65536") _
..End(xlUp).Offset(1, 0)
End
With <-- it won't compile, the With is highlighted in Red

------------------ start how you see it is how I have it now...

Option Explicit

Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long

Sub ChDirNet(szPath As String)
Dim IReturn As Long
IReturn = SetCurrentDirectoryA(szPath)
If IReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
End Sub

Sub Module_2_ImportDailyRetroboxforappend()
Dim Resp As Long
Dim networkPath As String
Dim MyFileName As Variant
Dim CurDriveFolder As String
Dim newWkbk As Workbook
Dim testRange As Range

networkPath = "\\HARDWARE\PCRecycle\test_network_append\"

CurDriveFolder = CurDir

On Error Resume Next
ChDirNet networkPath
If Err.Number <> 0 Then
MsgBox "error changing folder"
Err.Clear
End If
On Error GoTo 0

MyFileName = Application.GetOpenFilename("Excel Files, *.xls")
If MyFileName = False Then
'do nothing, user hit cancel
Else
Set newWkbk = Workbooks.Open(Filename:=MyFileName)
Set testRange = Nothing
On Error Resume Next
Set testRange = newWkbk.Names("Pick_Ups").RefersToRange
On Error GoTo 0

If testRange.Rows.Count < 2 Then
MsgBox "Only Headers!"
Else
With testRange
..Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0).Copy _
Destination:=ThisWorkbook.Worksheets("Import").Range("B65536") _
..End(xlUp).Offset(1, 0)
End
With
End If

End If

newWkbk.Close savechanges:=False

End If

ChDirNet CurDriveFolder

End Sub


---------- end

copy and paste between ---- start and ----- end and see what I am
taling about :- )

I appreciate your time helping me.
 
"End With" should be on one line.

But you still made other changes. You may want to copy from this post (some
wrap text formatting corrected).

Option Explicit

Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long

Sub ChDirNet(szPath As String)
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
End Sub

Sub ImportRetroBoxDailyFiles()
Dim Resp As Long
Dim networkPath As String
Dim MyFileName As Variant
Dim CurDriveFolder As String
Dim newWkbk As Workbook
Dim testRange As Range

networkPath = "\\HARDWARE\Requests\test_network_append\"

CurDriveFolder = CurDir

On Error Resume Next
ChDirNet networkPath
If Err.Number <> 0 Then
MsgBox "error changing folder"
Err.Clear
End If
On Error GoTo 0

MyFileName = Application.GetOpenFilename("Excel Files, *.xls")
If MyFileName = False Then
'do nothing, user hit cancel
Else
Set newWkbk = Workbooks.Open(Filename:=MyFileName)
Set testRange = Nothing
On Error Resume Next
Set testRange = newWkbk.Names("Pick_Ups").RefersToRange
On Error GoTo 0

If testRange Is Nothing Then
MsgBox "Pick_UPs wasn't found!"
Else
If testRange.Rows.Count < 2 Then
'if less then 2 rows, must be only headers , Ignore
MsgBox "Only Headers!" ' pop-up a box is only headers found
Else
With testRange
.Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0).Copy _
Destination:=ThisWorkbook.Worksheets("Import") _
.Range("B65536").End(xlUp).Offset(0, 0)
End With
End If
End If
End If

newWkbk.Close savechanges:=False

'thisworkbook.save '<---are you sure you want to save this workbook??

ChDirNet CurDriveFolder

End Sub

And this comment still stands:
But I still have heartburn over your .offset(0,0). I think you'll find that it
may be overwriting a cell with something in it.



I think I am a little bit lost: here is how the script looks exactly as
of now, I tried to change that area:
Click to expand...
<<snipped>>
 
Is this part right ?

If testRange.Rows.Count < 2 Then
MsgBox "Only Headers!"
Else
With testRange
..Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0).Copy _
Destination:=ThisWorkbook.Worksheets("Import").Range("B65536") _
..End(xlUp).Offset(1, 0)
End
With
End If
End If
newWkbk.Close savechanges:=False
End If
ChDirNet CurDriveFolder
End Sub

--- end

VB complains about that With before End If, End If
 
ok, damn I got it, one too many End If and the

End With needed to be on one line, you still a genious and I changes
that (1,0)

so no need to worry about that heart burn.

I'll be picking your brain later :- ) I wish I would take you out to
lunch for this help, where u live ?

Seattle area ?
 
Why did you remove this set of lines?

If testRange Is Nothing Then
MsgBox "Pick_UPs wasn't found!"
Else

It just a check to make sure that range name actually existed. If it doesn't
exist, then the rest of your code will fail very badly. If the name does exist,
then there's not a problem.

(I liked that check.)
 
good that you pointed it out, I totally brain farted yesterday, but
today when I look at things that
were complicated yesterday, they seem easier :- )

I post when I am at work through google, using a browser, so not sure
how they format the text, I preview it before posting it, but after
posting
it, things can change.

What do you think ?

If testRange Is Nothing Then
MsgBox "Pick_UPs wasn't found!"
Else
If testRange.Rows.Count < 2 Then
MsgBox "Only Headers!"
Else
With testRange
..Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0).Copy _
Destination:=ThisWorkbook.Worksheets("Import") _
..Range("B65536").End(xlUp).Offset(1, 0)
End With
End If
End If

hopefully none of the lines formatted crazy :- )
 
The lines did all bunch to the left, but if that matches that last version I
sent, I like it <bg>.
 
Back
Top