help with network script...

R

RompStar

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
 
D

Dave Peterson

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).
 
D

Dave Peterson

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.
 
R

RompStar

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.
 
D

Dave Peterson

"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>>
 
R

RompStar

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
 
R

RompStar

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 ?
 
D

Dave Peterson

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.)
 
R

RompStar

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 :- )
 
D

Dave Peterson

The lines did all bunch to the left, but if that matches that last version I
sent, I like it <bg>.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Word macro that can call cells out of Excel for a find and replace 0
VBA - exporting serial letters to single documents 0
not able to import *.eps files from network 0
Need help modifying code 0
VBA: how to get variables into querry code 2
Extract name, address and ph# 8
deleting workbooks as i go 4
UNC filepaths appearing 7

Top